{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Fadno.MusicXml.MusicXml31 where

import GHC.Generics
import Data.Data
import Data.Decimal
import Data.String
import Fadno.Xml.EmitXml
import qualified Fadno.Xml.XParse as P
import qualified Control.Applicative as P
import Control.Applicative ((<|>))
import qualified Control.Arrow as A

-- | @xs:ID@ /(simple)/
newtype ID = ID { ID -> NCName
iD :: NCName }
    deriving (ID -> ID -> Bool
(ID -> ID -> Bool) -> (ID -> ID -> Bool) -> Eq ID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ID -> ID -> Bool
$c/= :: ID -> ID -> Bool
== :: ID -> ID -> Bool
$c== :: ID -> ID -> Bool
Eq,Typeable,(forall x. ID -> Rep ID x)
-> (forall x. Rep ID x -> ID) -> Generic ID
forall x. Rep ID x -> ID
forall x. ID -> Rep ID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ID x -> ID
$cfrom :: forall x. ID -> Rep ID x
Generic,Eq ID
Eq ID
-> (ID -> ID -> Ordering)
-> (ID -> ID -> Bool)
-> (ID -> ID -> Bool)
-> (ID -> ID -> Bool)
-> (ID -> ID -> Bool)
-> (ID -> ID -> ID)
-> (ID -> ID -> ID)
-> Ord ID
ID -> ID -> Bool
ID -> ID -> Ordering
ID -> ID -> ID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ID -> ID -> ID
$cmin :: ID -> ID -> ID
max :: ID -> ID -> ID
$cmax :: ID -> ID -> ID
>= :: ID -> ID -> Bool
$c>= :: ID -> ID -> Bool
> :: ID -> ID -> Bool
$c> :: ID -> ID -> Bool
<= :: ID -> ID -> Bool
$c<= :: ID -> ID -> Bool
< :: ID -> ID -> Bool
$c< :: ID -> ID -> Bool
compare :: ID -> ID -> Ordering
$ccompare :: ID -> ID -> Ordering
$cp1Ord :: Eq ID
Ord,String -> ID
(String -> ID) -> IsString ID
forall a. (String -> a) -> IsString a
fromString :: String -> ID
$cfromString :: String -> ID
IsString)
instance Show ID where show :: ID -> String
show (ID NCName
a) = NCName -> String
forall a. Show a => a -> String
show NCName
a
instance Read ID where readsPrec :: Int -> ReadS ID
readsPrec Int
i = ((NCName, String) -> (ID, String))
-> [(NCName, String)] -> [(ID, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NCName -> ID) -> (NCName, String) -> (ID, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NCName -> ID
ID) ([(NCName, String)] -> [(ID, String)])
-> (String -> [(NCName, String)]) -> ReadS ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(NCName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml ID where
    emitXml :: ID -> XmlRep
emitXml = NCName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NCName -> XmlRep) -> (ID -> NCName) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ID -> NCName
iD
parseID :: String -> P.XParse ID
parseID :: String -> XParse ID
parseID = ID -> XParse ID
forall (m :: * -> *) a. Monad m => a -> m a
return (ID -> XParse ID) -> (String -> ID) -> String -> XParse ID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ID
forall a. IsString a => String -> a
fromString

-- | @xs:IDREF@ /(simple)/
newtype IDREF = IDREF { IDREF -> NCName
iDREF :: NCName }
    deriving (IDREF -> IDREF -> Bool
(IDREF -> IDREF -> Bool) -> (IDREF -> IDREF -> Bool) -> Eq IDREF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDREF -> IDREF -> Bool
$c/= :: IDREF -> IDREF -> Bool
== :: IDREF -> IDREF -> Bool
$c== :: IDREF -> IDREF -> Bool
Eq,Typeable,(forall x. IDREF -> Rep IDREF x)
-> (forall x. Rep IDREF x -> IDREF) -> Generic IDREF
forall x. Rep IDREF x -> IDREF
forall x. IDREF -> Rep IDREF x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IDREF x -> IDREF
$cfrom :: forall x. IDREF -> Rep IDREF x
Generic,Eq IDREF
Eq IDREF
-> (IDREF -> IDREF -> Ordering)
-> (IDREF -> IDREF -> Bool)
-> (IDREF -> IDREF -> Bool)
-> (IDREF -> IDREF -> Bool)
-> (IDREF -> IDREF -> Bool)
-> (IDREF -> IDREF -> IDREF)
-> (IDREF -> IDREF -> IDREF)
-> Ord IDREF
IDREF -> IDREF -> Bool
IDREF -> IDREF -> Ordering
IDREF -> IDREF -> IDREF
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IDREF -> IDREF -> IDREF
$cmin :: IDREF -> IDREF -> IDREF
max :: IDREF -> IDREF -> IDREF
$cmax :: IDREF -> IDREF -> IDREF
>= :: IDREF -> IDREF -> Bool
$c>= :: IDREF -> IDREF -> Bool
> :: IDREF -> IDREF -> Bool
$c> :: IDREF -> IDREF -> Bool
<= :: IDREF -> IDREF -> Bool
$c<= :: IDREF -> IDREF -> Bool
< :: IDREF -> IDREF -> Bool
$c< :: IDREF -> IDREF -> Bool
compare :: IDREF -> IDREF -> Ordering
$ccompare :: IDREF -> IDREF -> Ordering
$cp1Ord :: Eq IDREF
Ord,String -> IDREF
(String -> IDREF) -> IsString IDREF
forall a. (String -> a) -> IsString a
fromString :: String -> IDREF
$cfromString :: String -> IDREF
IsString)
instance Show IDREF where show :: IDREF -> String
show (IDREF NCName
a) = NCName -> String
forall a. Show a => a -> String
show NCName
a
instance Read IDREF where readsPrec :: Int -> ReadS IDREF
readsPrec Int
i = ((NCName, String) -> (IDREF, String))
-> [(NCName, String)] -> [(IDREF, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NCName -> IDREF) -> (NCName, String) -> (IDREF, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NCName -> IDREF
IDREF) ([(NCName, String)] -> [(IDREF, String)])
-> (String -> [(NCName, String)]) -> ReadS IDREF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(NCName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml IDREF where
    emitXml :: IDREF -> XmlRep
emitXml = NCName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NCName -> XmlRep) -> (IDREF -> NCName) -> IDREF -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IDREF -> NCName
iDREF
parseIDREF :: String -> P.XParse IDREF
parseIDREF :: String -> XParse IDREF
parseIDREF = IDREF -> XParse IDREF
forall (m :: * -> *) a. Monad m => a -> m a
return (IDREF -> XParse IDREF)
-> (String -> IDREF) -> String -> XParse IDREF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IDREF
forall a. IsString a => String -> a
fromString

-- | @xs:NCName@ /(simple)/
newtype NCName = NCName { NCName -> Name
nCName :: Name }
    deriving (NCName -> NCName -> Bool
(NCName -> NCName -> Bool)
-> (NCName -> NCName -> Bool) -> Eq NCName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NCName -> NCName -> Bool
$c/= :: NCName -> NCName -> Bool
== :: NCName -> NCName -> Bool
$c== :: NCName -> NCName -> Bool
Eq,Typeable,(forall x. NCName -> Rep NCName x)
-> (forall x. Rep NCName x -> NCName) -> Generic NCName
forall x. Rep NCName x -> NCName
forall x. NCName -> Rep NCName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NCName x -> NCName
$cfrom :: forall x. NCName -> Rep NCName x
Generic,Eq NCName
Eq NCName
-> (NCName -> NCName -> Ordering)
-> (NCName -> NCName -> Bool)
-> (NCName -> NCName -> Bool)
-> (NCName -> NCName -> Bool)
-> (NCName -> NCName -> Bool)
-> (NCName -> NCName -> NCName)
-> (NCName -> NCName -> NCName)
-> Ord NCName
NCName -> NCName -> Bool
NCName -> NCName -> Ordering
NCName -> NCName -> NCName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NCName -> NCName -> NCName
$cmin :: NCName -> NCName -> NCName
max :: NCName -> NCName -> NCName
$cmax :: NCName -> NCName -> NCName
>= :: NCName -> NCName -> Bool
$c>= :: NCName -> NCName -> Bool
> :: NCName -> NCName -> Bool
$c> :: NCName -> NCName -> Bool
<= :: NCName -> NCName -> Bool
$c<= :: NCName -> NCName -> Bool
< :: NCName -> NCName -> Bool
$c< :: NCName -> NCName -> Bool
compare :: NCName -> NCName -> Ordering
$ccompare :: NCName -> NCName -> Ordering
$cp1Ord :: Eq NCName
Ord,String -> NCName
(String -> NCName) -> IsString NCName
forall a. (String -> a) -> IsString a
fromString :: String -> NCName
$cfromString :: String -> NCName
IsString)
instance Show NCName where show :: NCName -> String
show (NCName Name
a) = Name -> String
forall a. Show a => a -> String
show Name
a
instance Read NCName where readsPrec :: Int -> String -> [(NCName, String)]
readsPrec Int
i = ((Name, String) -> (NCName, String))
-> [(Name, String)] -> [(NCName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> NCName) -> (Name, String) -> (NCName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Name -> NCName
NCName) ([(Name, String)] -> [(NCName, String)])
-> (String -> [(Name, String)]) -> String -> [(NCName, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Name, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NCName where
    emitXml :: NCName -> XmlRep
emitXml = Name -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Name -> XmlRep) -> (NCName -> Name) -> NCName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NCName -> Name
nCName
parseNCName :: String -> P.XParse NCName
parseNCName :: String -> XParse NCName
parseNCName = NCName -> XParse NCName
forall (m :: * -> *) a. Monad m => a -> m a
return (NCName -> XParse NCName)
-> (String -> NCName) -> String -> XParse NCName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NCName
forall a. IsString a => String -> a
fromString

-- | @xs:NMTOKEN@ /(simple)/
newtype NMTOKEN = NMTOKEN { NMTOKEN -> Token
nMTOKEN :: Token }
    deriving (NMTOKEN -> NMTOKEN -> Bool
(NMTOKEN -> NMTOKEN -> Bool)
-> (NMTOKEN -> NMTOKEN -> Bool) -> Eq NMTOKEN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NMTOKEN -> NMTOKEN -> Bool
$c/= :: NMTOKEN -> NMTOKEN -> Bool
== :: NMTOKEN -> NMTOKEN -> Bool
$c== :: NMTOKEN -> NMTOKEN -> Bool
Eq,Typeable,(forall x. NMTOKEN -> Rep NMTOKEN x)
-> (forall x. Rep NMTOKEN x -> NMTOKEN) -> Generic NMTOKEN
forall x. Rep NMTOKEN x -> NMTOKEN
forall x. NMTOKEN -> Rep NMTOKEN x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NMTOKEN x -> NMTOKEN
$cfrom :: forall x. NMTOKEN -> Rep NMTOKEN x
Generic,Eq NMTOKEN
Eq NMTOKEN
-> (NMTOKEN -> NMTOKEN -> Ordering)
-> (NMTOKEN -> NMTOKEN -> Bool)
-> (NMTOKEN -> NMTOKEN -> Bool)
-> (NMTOKEN -> NMTOKEN -> Bool)
-> (NMTOKEN -> NMTOKEN -> Bool)
-> (NMTOKEN -> NMTOKEN -> NMTOKEN)
-> (NMTOKEN -> NMTOKEN -> NMTOKEN)
-> Ord NMTOKEN
NMTOKEN -> NMTOKEN -> Bool
NMTOKEN -> NMTOKEN -> Ordering
NMTOKEN -> NMTOKEN -> NMTOKEN
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NMTOKEN -> NMTOKEN -> NMTOKEN
$cmin :: NMTOKEN -> NMTOKEN -> NMTOKEN
max :: NMTOKEN -> NMTOKEN -> NMTOKEN
$cmax :: NMTOKEN -> NMTOKEN -> NMTOKEN
>= :: NMTOKEN -> NMTOKEN -> Bool
$c>= :: NMTOKEN -> NMTOKEN -> Bool
> :: NMTOKEN -> NMTOKEN -> Bool
$c> :: NMTOKEN -> NMTOKEN -> Bool
<= :: NMTOKEN -> NMTOKEN -> Bool
$c<= :: NMTOKEN -> NMTOKEN -> Bool
< :: NMTOKEN -> NMTOKEN -> Bool
$c< :: NMTOKEN -> NMTOKEN -> Bool
compare :: NMTOKEN -> NMTOKEN -> Ordering
$ccompare :: NMTOKEN -> NMTOKEN -> Ordering
$cp1Ord :: Eq NMTOKEN
Ord,String -> NMTOKEN
(String -> NMTOKEN) -> IsString NMTOKEN
forall a. (String -> a) -> IsString a
fromString :: String -> NMTOKEN
$cfromString :: String -> NMTOKEN
IsString)
instance Show NMTOKEN where show :: NMTOKEN -> String
show (NMTOKEN Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read NMTOKEN where readsPrec :: Int -> ReadS NMTOKEN
readsPrec Int
i = ((Token, String) -> (NMTOKEN, String))
-> [(Token, String)] -> [(NMTOKEN, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> NMTOKEN) -> (Token, String) -> (NMTOKEN, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> NMTOKEN
NMTOKEN) ([(Token, String)] -> [(NMTOKEN, String)])
-> (String -> [(Token, String)]) -> ReadS NMTOKEN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NMTOKEN where
    emitXml :: NMTOKEN -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (NMTOKEN -> Token) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NMTOKEN -> Token
nMTOKEN
parseNMTOKEN :: String -> P.XParse NMTOKEN
parseNMTOKEN :: String -> XParse NMTOKEN
parseNMTOKEN = NMTOKEN -> XParse NMTOKEN
forall (m :: * -> *) a. Monad m => a -> m a
return (NMTOKEN -> XParse NMTOKEN)
-> (String -> NMTOKEN) -> String -> XParse NMTOKEN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NMTOKEN
forall a. IsString a => String -> a
fromString

-- | @xs:Name@ /(simple)/
newtype Name = Name { Name -> Token
name :: Token }
    deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq,Typeable,(forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generic,Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord,String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
fromString :: String -> Name
$cfromString :: String -> Name
IsString)
instance Show Name where show :: Name -> String
show (Name Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read Name where readsPrec :: Int -> String -> [(Name, String)]
readsPrec Int
i = ((Token, String) -> (Name, String))
-> [(Token, String)] -> [(Name, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> Name) -> (Token, String) -> (Name, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> Name
Name) ([(Token, String)] -> [(Name, String)])
-> (String -> [(Token, String)]) -> String -> [(Name, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Name where
    emitXml :: Name -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (Name -> Token) -> Name -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Token
name
parseName :: String -> P.XParse Name
parseName :: String -> XParse Name
parseName = Name -> XParse Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> XParse Name) -> (String -> Name) -> String -> XParse Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
forall a. IsString a => String -> a
fromString

-- | @above-below@ /(simple)/
--
-- The above-below type is used to indicate whether one element appears above or below another element.
data AboveBelow = 
      AboveBelowAbove -- ^ /above/
    | AboveBelowBelow -- ^ /below/
    deriving (AboveBelow -> AboveBelow -> Bool
(AboveBelow -> AboveBelow -> Bool)
-> (AboveBelow -> AboveBelow -> Bool) -> Eq AboveBelow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AboveBelow -> AboveBelow -> Bool
$c/= :: AboveBelow -> AboveBelow -> Bool
== :: AboveBelow -> AboveBelow -> Bool
$c== :: AboveBelow -> AboveBelow -> Bool
Eq,Typeable,(forall x. AboveBelow -> Rep AboveBelow x)
-> (forall x. Rep AboveBelow x -> AboveBelow) -> Generic AboveBelow
forall x. Rep AboveBelow x -> AboveBelow
forall x. AboveBelow -> Rep AboveBelow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AboveBelow x -> AboveBelow
$cfrom :: forall x. AboveBelow -> Rep AboveBelow x
Generic,Int -> AboveBelow -> ShowS
[AboveBelow] -> ShowS
AboveBelow -> String
(Int -> AboveBelow -> ShowS)
-> (AboveBelow -> String)
-> ([AboveBelow] -> ShowS)
-> Show AboveBelow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AboveBelow] -> ShowS
$cshowList :: [AboveBelow] -> ShowS
show :: AboveBelow -> String
$cshow :: AboveBelow -> String
showsPrec :: Int -> AboveBelow -> ShowS
$cshowsPrec :: Int -> AboveBelow -> ShowS
Show,Eq AboveBelow
Eq AboveBelow
-> (AboveBelow -> AboveBelow -> Ordering)
-> (AboveBelow -> AboveBelow -> Bool)
-> (AboveBelow -> AboveBelow -> Bool)
-> (AboveBelow -> AboveBelow -> Bool)
-> (AboveBelow -> AboveBelow -> Bool)
-> (AboveBelow -> AboveBelow -> AboveBelow)
-> (AboveBelow -> AboveBelow -> AboveBelow)
-> Ord AboveBelow
AboveBelow -> AboveBelow -> Bool
AboveBelow -> AboveBelow -> Ordering
AboveBelow -> AboveBelow -> AboveBelow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AboveBelow -> AboveBelow -> AboveBelow
$cmin :: AboveBelow -> AboveBelow -> AboveBelow
max :: AboveBelow -> AboveBelow -> AboveBelow
$cmax :: AboveBelow -> AboveBelow -> AboveBelow
>= :: AboveBelow -> AboveBelow -> Bool
$c>= :: AboveBelow -> AboveBelow -> Bool
> :: AboveBelow -> AboveBelow -> Bool
$c> :: AboveBelow -> AboveBelow -> Bool
<= :: AboveBelow -> AboveBelow -> Bool
$c<= :: AboveBelow -> AboveBelow -> Bool
< :: AboveBelow -> AboveBelow -> Bool
$c< :: AboveBelow -> AboveBelow -> Bool
compare :: AboveBelow -> AboveBelow -> Ordering
$ccompare :: AboveBelow -> AboveBelow -> Ordering
$cp1Ord :: Eq AboveBelow
Ord,Int -> AboveBelow
AboveBelow -> Int
AboveBelow -> [AboveBelow]
AboveBelow -> AboveBelow
AboveBelow -> AboveBelow -> [AboveBelow]
AboveBelow -> AboveBelow -> AboveBelow -> [AboveBelow]
(AboveBelow -> AboveBelow)
-> (AboveBelow -> AboveBelow)
-> (Int -> AboveBelow)
-> (AboveBelow -> Int)
-> (AboveBelow -> [AboveBelow])
-> (AboveBelow -> AboveBelow -> [AboveBelow])
-> (AboveBelow -> AboveBelow -> [AboveBelow])
-> (AboveBelow -> AboveBelow -> AboveBelow -> [AboveBelow])
-> Enum AboveBelow
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AboveBelow -> AboveBelow -> AboveBelow -> [AboveBelow]
$cenumFromThenTo :: AboveBelow -> AboveBelow -> AboveBelow -> [AboveBelow]
enumFromTo :: AboveBelow -> AboveBelow -> [AboveBelow]
$cenumFromTo :: AboveBelow -> AboveBelow -> [AboveBelow]
enumFromThen :: AboveBelow -> AboveBelow -> [AboveBelow]
$cenumFromThen :: AboveBelow -> AboveBelow -> [AboveBelow]
enumFrom :: AboveBelow -> [AboveBelow]
$cenumFrom :: AboveBelow -> [AboveBelow]
fromEnum :: AboveBelow -> Int
$cfromEnum :: AboveBelow -> Int
toEnum :: Int -> AboveBelow
$ctoEnum :: Int -> AboveBelow
pred :: AboveBelow -> AboveBelow
$cpred :: AboveBelow -> AboveBelow
succ :: AboveBelow -> AboveBelow
$csucc :: AboveBelow -> AboveBelow
Enum,AboveBelow
AboveBelow -> AboveBelow -> Bounded AboveBelow
forall a. a -> a -> Bounded a
maxBound :: AboveBelow
$cmaxBound :: AboveBelow
minBound :: AboveBelow
$cminBound :: AboveBelow
Bounded)
instance EmitXml AboveBelow where
    emitXml :: AboveBelow -> XmlRep
emitXml AboveBelow
AboveBelowAbove = String -> XmlRep
XLit String
"above"
    emitXml AboveBelow
AboveBelowBelow = String -> XmlRep
XLit String
"below"
parseAboveBelow :: String -> P.XParse AboveBelow
parseAboveBelow :: String -> XParse AboveBelow
parseAboveBelow String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"above" = AboveBelow -> XParse AboveBelow
forall (m :: * -> *) a. Monad m => a -> m a
return (AboveBelow -> XParse AboveBelow)
-> AboveBelow -> XParse AboveBelow
forall a b. (a -> b) -> a -> b
$ AboveBelow
AboveBelowAbove
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"below" = AboveBelow -> XParse AboveBelow
forall (m :: * -> *) a. Monad m => a -> m a
return (AboveBelow -> XParse AboveBelow)
-> AboveBelow -> XParse AboveBelow
forall a b. (a -> b) -> a -> b
$ AboveBelow
AboveBelowBelow
        | Bool
otherwise = String -> XParse AboveBelow
forall a. String -> XParse a
P.xfail (String -> XParse AboveBelow) -> String -> XParse AboveBelow
forall a b. (a -> b) -> a -> b
$ String
"AboveBelow: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @accidental-value@ /(simple)/
--
-- The accidental-value type represents notated accidentals supported by MusicXML. In the MusicXML 2.0 DTD this was a string with values that could be included. The XSD strengthens the data typing to an enumerated list. The quarter- and three-quarters- accidentals are Tartini-style quarter-tone accidentals. The -down and -up accidentals are quarter-tone accidentals that include arrows pointing down or up. The slash- accidentals are used in Turkish classical music. The numbered sharp and flat accidentals are superscripted versions of the accidental signs, used in Turkish folk music. The sori and koron accidentals are microtonal sharp and flat accidentals used in Iranian and Persian music. The other accidental covers accidentals other than those listed here. It is usually used in combination with the smufl attribute to specify a particular SMuFL accidental. The smufl attribute may be used with any accidental value to help specify the appearance of symbols that share the same MusicXML semantics.
data AccidentalValue = 
      AccidentalValueSharp -- ^ /sharp/
    | AccidentalValueNatural -- ^ /natural/
    | AccidentalValueFlat -- ^ /flat/
    | AccidentalValueDoubleSharp -- ^ /double-sharp/
    | AccidentalValueSharpSharp -- ^ /sharp-sharp/
    | AccidentalValueFlatFlat -- ^ /flat-flat/
    | AccidentalValueNaturalSharp -- ^ /natural-sharp/
    | AccidentalValueNaturalFlat -- ^ /natural-flat/
    | AccidentalValueQuarterFlat -- ^ /quarter-flat/
    | AccidentalValueQuarterSharp -- ^ /quarter-sharp/
    | AccidentalValueThreeQuartersFlat -- ^ /three-quarters-flat/
    | AccidentalValueThreeQuartersSharp -- ^ /three-quarters-sharp/
    | AccidentalValueSharpDown -- ^ /sharp-down/
    | AccidentalValueSharpUp -- ^ /sharp-up/
    | AccidentalValueNaturalDown -- ^ /natural-down/
    | AccidentalValueNaturalUp -- ^ /natural-up/
    | AccidentalValueFlatDown -- ^ /flat-down/
    | AccidentalValueFlatUp -- ^ /flat-up/
    | AccidentalValueDoubleSharpDown -- ^ /double-sharp-down/
    | AccidentalValueDoubleSharpUp -- ^ /double-sharp-up/
    | AccidentalValueFlatFlatDown -- ^ /flat-flat-down/
    | AccidentalValueFlatFlatUp -- ^ /flat-flat-up/
    | AccidentalValueArrowDown -- ^ /arrow-down/
    | AccidentalValueArrowUp -- ^ /arrow-up/
    | AccidentalValueTripleSharp -- ^ /triple-sharp/
    | AccidentalValueTripleFlat -- ^ /triple-flat/
    | AccidentalValueSlashQuarterSharp -- ^ /slash-quarter-sharp/
    | AccidentalValueSlashSharp -- ^ /slash-sharp/
    | AccidentalValueSlashFlat -- ^ /slash-flat/
    | AccidentalValueDoubleSlashFlat -- ^ /double-slash-flat/
    | AccidentalValueSharp1 -- ^ /sharp-1/
    | AccidentalValueSharp2 -- ^ /sharp-2/
    | AccidentalValueSharp3 -- ^ /sharp-3/
    | AccidentalValueSharp5 -- ^ /sharp-5/
    | AccidentalValueFlat1 -- ^ /flat-1/
    | AccidentalValueFlat2 -- ^ /flat-2/
    | AccidentalValueFlat3 -- ^ /flat-3/
    | AccidentalValueFlat4 -- ^ /flat-4/
    | AccidentalValueSori -- ^ /sori/
    | AccidentalValueKoron -- ^ /koron/
    | AccidentalValueOther -- ^ /other/
    deriving (AccidentalValue -> AccidentalValue -> Bool
(AccidentalValue -> AccidentalValue -> Bool)
-> (AccidentalValue -> AccidentalValue -> Bool)
-> Eq AccidentalValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccidentalValue -> AccidentalValue -> Bool
$c/= :: AccidentalValue -> AccidentalValue -> Bool
== :: AccidentalValue -> AccidentalValue -> Bool
$c== :: AccidentalValue -> AccidentalValue -> Bool
Eq,Typeable,(forall x. AccidentalValue -> Rep AccidentalValue x)
-> (forall x. Rep AccidentalValue x -> AccidentalValue)
-> Generic AccidentalValue
forall x. Rep AccidentalValue x -> AccidentalValue
forall x. AccidentalValue -> Rep AccidentalValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccidentalValue x -> AccidentalValue
$cfrom :: forall x. AccidentalValue -> Rep AccidentalValue x
Generic,Int -> AccidentalValue -> ShowS
[AccidentalValue] -> ShowS
AccidentalValue -> String
(Int -> AccidentalValue -> ShowS)
-> (AccidentalValue -> String)
-> ([AccidentalValue] -> ShowS)
-> Show AccidentalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccidentalValue] -> ShowS
$cshowList :: [AccidentalValue] -> ShowS
show :: AccidentalValue -> String
$cshow :: AccidentalValue -> String
showsPrec :: Int -> AccidentalValue -> ShowS
$cshowsPrec :: Int -> AccidentalValue -> ShowS
Show,Eq AccidentalValue
Eq AccidentalValue
-> (AccidentalValue -> AccidentalValue -> Ordering)
-> (AccidentalValue -> AccidentalValue -> Bool)
-> (AccidentalValue -> AccidentalValue -> Bool)
-> (AccidentalValue -> AccidentalValue -> Bool)
-> (AccidentalValue -> AccidentalValue -> Bool)
-> (AccidentalValue -> AccidentalValue -> AccidentalValue)
-> (AccidentalValue -> AccidentalValue -> AccidentalValue)
-> Ord AccidentalValue
AccidentalValue -> AccidentalValue -> Bool
AccidentalValue -> AccidentalValue -> Ordering
AccidentalValue -> AccidentalValue -> AccidentalValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AccidentalValue -> AccidentalValue -> AccidentalValue
$cmin :: AccidentalValue -> AccidentalValue -> AccidentalValue
max :: AccidentalValue -> AccidentalValue -> AccidentalValue
$cmax :: AccidentalValue -> AccidentalValue -> AccidentalValue
>= :: AccidentalValue -> AccidentalValue -> Bool
$c>= :: AccidentalValue -> AccidentalValue -> Bool
> :: AccidentalValue -> AccidentalValue -> Bool
$c> :: AccidentalValue -> AccidentalValue -> Bool
<= :: AccidentalValue -> AccidentalValue -> Bool
$c<= :: AccidentalValue -> AccidentalValue -> Bool
< :: AccidentalValue -> AccidentalValue -> Bool
$c< :: AccidentalValue -> AccidentalValue -> Bool
compare :: AccidentalValue -> AccidentalValue -> Ordering
$ccompare :: AccidentalValue -> AccidentalValue -> Ordering
$cp1Ord :: Eq AccidentalValue
Ord,Int -> AccidentalValue
AccidentalValue -> Int
AccidentalValue -> [AccidentalValue]
AccidentalValue -> AccidentalValue
AccidentalValue -> AccidentalValue -> [AccidentalValue]
AccidentalValue
-> AccidentalValue -> AccidentalValue -> [AccidentalValue]
(AccidentalValue -> AccidentalValue)
-> (AccidentalValue -> AccidentalValue)
-> (Int -> AccidentalValue)
-> (AccidentalValue -> Int)
-> (AccidentalValue -> [AccidentalValue])
-> (AccidentalValue -> AccidentalValue -> [AccidentalValue])
-> (AccidentalValue -> AccidentalValue -> [AccidentalValue])
-> (AccidentalValue
    -> AccidentalValue -> AccidentalValue -> [AccidentalValue])
-> Enum AccidentalValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AccidentalValue
-> AccidentalValue -> AccidentalValue -> [AccidentalValue]
$cenumFromThenTo :: AccidentalValue
-> AccidentalValue -> AccidentalValue -> [AccidentalValue]
enumFromTo :: AccidentalValue -> AccidentalValue -> [AccidentalValue]
$cenumFromTo :: AccidentalValue -> AccidentalValue -> [AccidentalValue]
enumFromThen :: AccidentalValue -> AccidentalValue -> [AccidentalValue]
$cenumFromThen :: AccidentalValue -> AccidentalValue -> [AccidentalValue]
enumFrom :: AccidentalValue -> [AccidentalValue]
$cenumFrom :: AccidentalValue -> [AccidentalValue]
fromEnum :: AccidentalValue -> Int
$cfromEnum :: AccidentalValue -> Int
toEnum :: Int -> AccidentalValue
$ctoEnum :: Int -> AccidentalValue
pred :: AccidentalValue -> AccidentalValue
$cpred :: AccidentalValue -> AccidentalValue
succ :: AccidentalValue -> AccidentalValue
$csucc :: AccidentalValue -> AccidentalValue
Enum,AccidentalValue
AccidentalValue -> AccidentalValue -> Bounded AccidentalValue
forall a. a -> a -> Bounded a
maxBound :: AccidentalValue
$cmaxBound :: AccidentalValue
minBound :: AccidentalValue
$cminBound :: AccidentalValue
Bounded)
instance EmitXml AccidentalValue where
    emitXml :: AccidentalValue -> XmlRep
emitXml AccidentalValue
AccidentalValueSharp = String -> XmlRep
XLit String
"sharp"
    emitXml AccidentalValue
AccidentalValueNatural = String -> XmlRep
XLit String
"natural"
    emitXml AccidentalValue
AccidentalValueFlat = String -> XmlRep
XLit String
"flat"
    emitXml AccidentalValue
AccidentalValueDoubleSharp = String -> XmlRep
XLit String
"double-sharp"
    emitXml AccidentalValue
AccidentalValueSharpSharp = String -> XmlRep
XLit String
"sharp-sharp"
    emitXml AccidentalValue
AccidentalValueFlatFlat = String -> XmlRep
XLit String
"flat-flat"
    emitXml AccidentalValue
AccidentalValueNaturalSharp = String -> XmlRep
XLit String
"natural-sharp"
    emitXml AccidentalValue
AccidentalValueNaturalFlat = String -> XmlRep
XLit String
"natural-flat"
    emitXml AccidentalValue
AccidentalValueQuarterFlat = String -> XmlRep
XLit String
"quarter-flat"
    emitXml AccidentalValue
AccidentalValueQuarterSharp = String -> XmlRep
XLit String
"quarter-sharp"
    emitXml AccidentalValue
AccidentalValueThreeQuartersFlat = String -> XmlRep
XLit String
"three-quarters-flat"
    emitXml AccidentalValue
AccidentalValueThreeQuartersSharp = String -> XmlRep
XLit String
"three-quarters-sharp"
    emitXml AccidentalValue
AccidentalValueSharpDown = String -> XmlRep
XLit String
"sharp-down"
    emitXml AccidentalValue
AccidentalValueSharpUp = String -> XmlRep
XLit String
"sharp-up"
    emitXml AccidentalValue
AccidentalValueNaturalDown = String -> XmlRep
XLit String
"natural-down"
    emitXml AccidentalValue
AccidentalValueNaturalUp = String -> XmlRep
XLit String
"natural-up"
    emitXml AccidentalValue
AccidentalValueFlatDown = String -> XmlRep
XLit String
"flat-down"
    emitXml AccidentalValue
AccidentalValueFlatUp = String -> XmlRep
XLit String
"flat-up"
    emitXml AccidentalValue
AccidentalValueDoubleSharpDown = String -> XmlRep
XLit String
"double-sharp-down"
    emitXml AccidentalValue
AccidentalValueDoubleSharpUp = String -> XmlRep
XLit String
"double-sharp-up"
    emitXml AccidentalValue
AccidentalValueFlatFlatDown = String -> XmlRep
XLit String
"flat-flat-down"
    emitXml AccidentalValue
AccidentalValueFlatFlatUp = String -> XmlRep
XLit String
"flat-flat-up"
    emitXml AccidentalValue
AccidentalValueArrowDown = String -> XmlRep
XLit String
"arrow-down"
    emitXml AccidentalValue
AccidentalValueArrowUp = String -> XmlRep
XLit String
"arrow-up"
    emitXml AccidentalValue
AccidentalValueTripleSharp = String -> XmlRep
XLit String
"triple-sharp"
    emitXml AccidentalValue
AccidentalValueTripleFlat = String -> XmlRep
XLit String
"triple-flat"
    emitXml AccidentalValue
AccidentalValueSlashQuarterSharp = String -> XmlRep
XLit String
"slash-quarter-sharp"
    emitXml AccidentalValue
AccidentalValueSlashSharp = String -> XmlRep
XLit String
"slash-sharp"
    emitXml AccidentalValue
AccidentalValueSlashFlat = String -> XmlRep
XLit String
"slash-flat"
    emitXml AccidentalValue
AccidentalValueDoubleSlashFlat = String -> XmlRep
XLit String
"double-slash-flat"
    emitXml AccidentalValue
AccidentalValueSharp1 = String -> XmlRep
XLit String
"sharp-1"
    emitXml AccidentalValue
AccidentalValueSharp2 = String -> XmlRep
XLit String
"sharp-2"
    emitXml AccidentalValue
AccidentalValueSharp3 = String -> XmlRep
XLit String
"sharp-3"
    emitXml AccidentalValue
AccidentalValueSharp5 = String -> XmlRep
XLit String
"sharp-5"
    emitXml AccidentalValue
AccidentalValueFlat1 = String -> XmlRep
XLit String
"flat-1"
    emitXml AccidentalValue
AccidentalValueFlat2 = String -> XmlRep
XLit String
"flat-2"
    emitXml AccidentalValue
AccidentalValueFlat3 = String -> XmlRep
XLit String
"flat-3"
    emitXml AccidentalValue
AccidentalValueFlat4 = String -> XmlRep
XLit String
"flat-4"
    emitXml AccidentalValue
AccidentalValueSori = String -> XmlRep
XLit String
"sori"
    emitXml AccidentalValue
AccidentalValueKoron = String -> XmlRep
XLit String
"koron"
    emitXml AccidentalValue
AccidentalValueOther = String -> XmlRep
XLit String
"other"
parseAccidentalValue :: String -> P.XParse AccidentalValue
parseAccidentalValue :: String -> XParse AccidentalValue
parseAccidentalValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"natural" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueNatural
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueDoubleSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharpSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlatFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"natural-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueNaturalSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"natural-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueNaturalFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"quarter-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueQuarterFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"quarter-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueQuarterSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"three-quarters-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueThreeQuartersFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"three-quarters-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueThreeQuartersSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharpDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharpUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"natural-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueNaturalDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"natural-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueNaturalUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlatDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlatUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-sharp-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueDoubleSharpDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-sharp-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueDoubleSharpUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-flat-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlatFlatDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-flat-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlatFlatUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arrow-down" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueArrowDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arrow-up" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueArrowUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triple-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueTripleSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triple-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueTripleFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slash-quarter-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSlashQuarterSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slash-sharp" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSlashSharp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slash-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSlashFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-slash-flat" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueDoubleSlashFlat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-1" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharp1
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-2" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharp2
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-3" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharp3
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sharp-5" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSharp5
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-1" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlat1
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-2" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlat2
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-3" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlat3
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flat-4" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueFlat4
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sori" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueSori
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"koron" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueKoron
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = AccidentalValue -> XParse AccidentalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (AccidentalValue -> XParse AccidentalValue)
-> AccidentalValue -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ AccidentalValue
AccidentalValueOther
        | Bool
otherwise = String -> XParse AccidentalValue
forall a. String -> XParse a
P.xfail (String -> XParse AccidentalValue)
-> String -> XParse AccidentalValue
forall a b. (a -> b) -> a -> b
$ String
"AccidentalValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @accordion-middle@ /(simple)/
--
-- The accordion-middle type may have values of 1, 2, or 3, corresponding to having 1 to 3 dots in the middle section of the accordion registration symbol. This type is not used if no dots are present.
newtype AccordionMiddle = AccordionMiddle { AccordionMiddle -> PositiveInteger
accordionMiddle :: PositiveInteger }
    deriving (AccordionMiddle -> AccordionMiddle -> Bool
(AccordionMiddle -> AccordionMiddle -> Bool)
-> (AccordionMiddle -> AccordionMiddle -> Bool)
-> Eq AccordionMiddle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccordionMiddle -> AccordionMiddle -> Bool
$c/= :: AccordionMiddle -> AccordionMiddle -> Bool
== :: AccordionMiddle -> AccordionMiddle -> Bool
$c== :: AccordionMiddle -> AccordionMiddle -> Bool
Eq,Typeable,(forall x. AccordionMiddle -> Rep AccordionMiddle x)
-> (forall x. Rep AccordionMiddle x -> AccordionMiddle)
-> Generic AccordionMiddle
forall x. Rep AccordionMiddle x -> AccordionMiddle
forall x. AccordionMiddle -> Rep AccordionMiddle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccordionMiddle x -> AccordionMiddle
$cfrom :: forall x. AccordionMiddle -> Rep AccordionMiddle x
Generic,Eq AccordionMiddle
Eq AccordionMiddle
-> (AccordionMiddle -> AccordionMiddle -> Ordering)
-> (AccordionMiddle -> AccordionMiddle -> Bool)
-> (AccordionMiddle -> AccordionMiddle -> Bool)
-> (AccordionMiddle -> AccordionMiddle -> Bool)
-> (AccordionMiddle -> AccordionMiddle -> Bool)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> Ord AccordionMiddle
AccordionMiddle -> AccordionMiddle -> Bool
AccordionMiddle -> AccordionMiddle -> Ordering
AccordionMiddle -> AccordionMiddle -> AccordionMiddle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cmin :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
max :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cmax :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
>= :: AccordionMiddle -> AccordionMiddle -> Bool
$c>= :: AccordionMiddle -> AccordionMiddle -> Bool
> :: AccordionMiddle -> AccordionMiddle -> Bool
$c> :: AccordionMiddle -> AccordionMiddle -> Bool
<= :: AccordionMiddle -> AccordionMiddle -> Bool
$c<= :: AccordionMiddle -> AccordionMiddle -> Bool
< :: AccordionMiddle -> AccordionMiddle -> Bool
$c< :: AccordionMiddle -> AccordionMiddle -> Bool
compare :: AccordionMiddle -> AccordionMiddle -> Ordering
$ccompare :: AccordionMiddle -> AccordionMiddle -> Ordering
$cp1Ord :: Eq AccordionMiddle
Ord,AccordionMiddle
AccordionMiddle -> AccordionMiddle -> Bounded AccordionMiddle
forall a. a -> a -> Bounded a
maxBound :: AccordionMiddle
$cmaxBound :: AccordionMiddle
minBound :: AccordionMiddle
$cminBound :: AccordionMiddle
Bounded,Int -> AccordionMiddle
AccordionMiddle -> Int
AccordionMiddle -> [AccordionMiddle]
AccordionMiddle -> AccordionMiddle
AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
AccordionMiddle
-> AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
(AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle)
-> (Int -> AccordionMiddle)
-> (AccordionMiddle -> Int)
-> (AccordionMiddle -> [AccordionMiddle])
-> (AccordionMiddle -> AccordionMiddle -> [AccordionMiddle])
-> (AccordionMiddle -> AccordionMiddle -> [AccordionMiddle])
-> (AccordionMiddle
    -> AccordionMiddle -> AccordionMiddle -> [AccordionMiddle])
-> Enum AccordionMiddle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AccordionMiddle
-> AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
$cenumFromThenTo :: AccordionMiddle
-> AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
enumFromTo :: AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
$cenumFromTo :: AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
enumFromThen :: AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
$cenumFromThen :: AccordionMiddle -> AccordionMiddle -> [AccordionMiddle]
enumFrom :: AccordionMiddle -> [AccordionMiddle]
$cenumFrom :: AccordionMiddle -> [AccordionMiddle]
fromEnum :: AccordionMiddle -> Int
$cfromEnum :: AccordionMiddle -> Int
toEnum :: Int -> AccordionMiddle
$ctoEnum :: Int -> AccordionMiddle
pred :: AccordionMiddle -> AccordionMiddle
$cpred :: AccordionMiddle -> AccordionMiddle
succ :: AccordionMiddle -> AccordionMiddle
$csucc :: AccordionMiddle -> AccordionMiddle
Enum,Integer -> AccordionMiddle
AccordionMiddle -> AccordionMiddle
AccordionMiddle -> AccordionMiddle -> AccordionMiddle
(AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle)
-> (Integer -> AccordionMiddle)
-> Num AccordionMiddle
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> AccordionMiddle
$cfromInteger :: Integer -> AccordionMiddle
signum :: AccordionMiddle -> AccordionMiddle
$csignum :: AccordionMiddle -> AccordionMiddle
abs :: AccordionMiddle -> AccordionMiddle
$cabs :: AccordionMiddle -> AccordionMiddle
negate :: AccordionMiddle -> AccordionMiddle
$cnegate :: AccordionMiddle -> AccordionMiddle
* :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$c* :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
- :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$c- :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
+ :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$c+ :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
Num,Num AccordionMiddle
Ord AccordionMiddle
Num AccordionMiddle
-> Ord AccordionMiddle
-> (AccordionMiddle -> Rational)
-> Real AccordionMiddle
AccordionMiddle -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: AccordionMiddle -> Rational
$ctoRational :: AccordionMiddle -> Rational
$cp2Real :: Ord AccordionMiddle
$cp1Real :: Num AccordionMiddle
Real,Enum AccordionMiddle
Real AccordionMiddle
Real AccordionMiddle
-> Enum AccordionMiddle
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle -> AccordionMiddle -> AccordionMiddle)
-> (AccordionMiddle
    -> AccordionMiddle -> (AccordionMiddle, AccordionMiddle))
-> (AccordionMiddle
    -> AccordionMiddle -> (AccordionMiddle, AccordionMiddle))
-> (AccordionMiddle -> Integer)
-> Integral AccordionMiddle
AccordionMiddle -> Integer
AccordionMiddle
-> AccordionMiddle -> (AccordionMiddle, AccordionMiddle)
AccordionMiddle -> AccordionMiddle -> AccordionMiddle
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: AccordionMiddle -> Integer
$ctoInteger :: AccordionMiddle -> Integer
divMod :: AccordionMiddle
-> AccordionMiddle -> (AccordionMiddle, AccordionMiddle)
$cdivMod :: AccordionMiddle
-> AccordionMiddle -> (AccordionMiddle, AccordionMiddle)
quotRem :: AccordionMiddle
-> AccordionMiddle -> (AccordionMiddle, AccordionMiddle)
$cquotRem :: AccordionMiddle
-> AccordionMiddle -> (AccordionMiddle, AccordionMiddle)
mod :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cmod :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
div :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cdiv :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
rem :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$crem :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
quot :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cquot :: AccordionMiddle -> AccordionMiddle -> AccordionMiddle
$cp2Integral :: Enum AccordionMiddle
$cp1Integral :: Real AccordionMiddle
Integral)
instance Show AccordionMiddle where show :: AccordionMiddle -> String
show (AccordionMiddle PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read AccordionMiddle where readsPrec :: Int -> ReadS AccordionMiddle
readsPrec Int
i = ((PositiveInteger, String) -> (AccordionMiddle, String))
-> [(PositiveInteger, String)] -> [(AccordionMiddle, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> AccordionMiddle)
-> (PositiveInteger, String) -> (AccordionMiddle, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> AccordionMiddle
AccordionMiddle) ([(PositiveInteger, String)] -> [(AccordionMiddle, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS AccordionMiddle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml AccordionMiddle where
    emitXml :: AccordionMiddle -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (AccordionMiddle -> PositiveInteger)
-> AccordionMiddle
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccordionMiddle -> PositiveInteger
accordionMiddle
parseAccordionMiddle :: String -> P.XParse AccordionMiddle
parseAccordionMiddle :: String -> XParse AccordionMiddle
parseAccordionMiddle = String -> String -> XParse AccordionMiddle
forall a. Read a => String -> String -> XParse a
P.xread String
"AccordionMiddle"

-- | @xlink:actuate@ /(simple)/
data Actuate = 
      ActuateOnRequest -- ^ /onRequest/
    | ActuateOnLoad -- ^ /onLoad/
    | ActuateOther -- ^ /other/
    | ActuateNone -- ^ /none/
    deriving (Actuate -> Actuate -> Bool
(Actuate -> Actuate -> Bool)
-> (Actuate -> Actuate -> Bool) -> Eq Actuate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Actuate -> Actuate -> Bool
$c/= :: Actuate -> Actuate -> Bool
== :: Actuate -> Actuate -> Bool
$c== :: Actuate -> Actuate -> Bool
Eq,Typeable,(forall x. Actuate -> Rep Actuate x)
-> (forall x. Rep Actuate x -> Actuate) -> Generic Actuate
forall x. Rep Actuate x -> Actuate
forall x. Actuate -> Rep Actuate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Actuate x -> Actuate
$cfrom :: forall x. Actuate -> Rep Actuate x
Generic,Int -> Actuate -> ShowS
[Actuate] -> ShowS
Actuate -> String
(Int -> Actuate -> ShowS)
-> (Actuate -> String) -> ([Actuate] -> ShowS) -> Show Actuate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Actuate] -> ShowS
$cshowList :: [Actuate] -> ShowS
show :: Actuate -> String
$cshow :: Actuate -> String
showsPrec :: Int -> Actuate -> ShowS
$cshowsPrec :: Int -> Actuate -> ShowS
Show,Eq Actuate
Eq Actuate
-> (Actuate -> Actuate -> Ordering)
-> (Actuate -> Actuate -> Bool)
-> (Actuate -> Actuate -> Bool)
-> (Actuate -> Actuate -> Bool)
-> (Actuate -> Actuate -> Bool)
-> (Actuate -> Actuate -> Actuate)
-> (Actuate -> Actuate -> Actuate)
-> Ord Actuate
Actuate -> Actuate -> Bool
Actuate -> Actuate -> Ordering
Actuate -> Actuate -> Actuate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Actuate -> Actuate -> Actuate
$cmin :: Actuate -> Actuate -> Actuate
max :: Actuate -> Actuate -> Actuate
$cmax :: Actuate -> Actuate -> Actuate
>= :: Actuate -> Actuate -> Bool
$c>= :: Actuate -> Actuate -> Bool
> :: Actuate -> Actuate -> Bool
$c> :: Actuate -> Actuate -> Bool
<= :: Actuate -> Actuate -> Bool
$c<= :: Actuate -> Actuate -> Bool
< :: Actuate -> Actuate -> Bool
$c< :: Actuate -> Actuate -> Bool
compare :: Actuate -> Actuate -> Ordering
$ccompare :: Actuate -> Actuate -> Ordering
$cp1Ord :: Eq Actuate
Ord,Int -> Actuate
Actuate -> Int
Actuate -> [Actuate]
Actuate -> Actuate
Actuate -> Actuate -> [Actuate]
Actuate -> Actuate -> Actuate -> [Actuate]
(Actuate -> Actuate)
-> (Actuate -> Actuate)
-> (Int -> Actuate)
-> (Actuate -> Int)
-> (Actuate -> [Actuate])
-> (Actuate -> Actuate -> [Actuate])
-> (Actuate -> Actuate -> [Actuate])
-> (Actuate -> Actuate -> Actuate -> [Actuate])
-> Enum Actuate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Actuate -> Actuate -> Actuate -> [Actuate]
$cenumFromThenTo :: Actuate -> Actuate -> Actuate -> [Actuate]
enumFromTo :: Actuate -> Actuate -> [Actuate]
$cenumFromTo :: Actuate -> Actuate -> [Actuate]
enumFromThen :: Actuate -> Actuate -> [Actuate]
$cenumFromThen :: Actuate -> Actuate -> [Actuate]
enumFrom :: Actuate -> [Actuate]
$cenumFrom :: Actuate -> [Actuate]
fromEnum :: Actuate -> Int
$cfromEnum :: Actuate -> Int
toEnum :: Int -> Actuate
$ctoEnum :: Int -> Actuate
pred :: Actuate -> Actuate
$cpred :: Actuate -> Actuate
succ :: Actuate -> Actuate
$csucc :: Actuate -> Actuate
Enum,Actuate
Actuate -> Actuate -> Bounded Actuate
forall a. a -> a -> Bounded a
maxBound :: Actuate
$cmaxBound :: Actuate
minBound :: Actuate
$cminBound :: Actuate
Bounded)
instance EmitXml Actuate where
    emitXml :: Actuate -> XmlRep
emitXml Actuate
ActuateOnRequest = String -> XmlRep
XLit String
"onRequest"
    emitXml Actuate
ActuateOnLoad = String -> XmlRep
XLit String
"onLoad"
    emitXml Actuate
ActuateOther = String -> XmlRep
XLit String
"other"
    emitXml Actuate
ActuateNone = String -> XmlRep
XLit String
"none"
parseActuate :: String -> P.XParse Actuate
parseActuate :: String -> XParse Actuate
parseActuate String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"onRequest" = Actuate -> XParse Actuate
forall (m :: * -> *) a. Monad m => a -> m a
return (Actuate -> XParse Actuate) -> Actuate -> XParse Actuate
forall a b. (a -> b) -> a -> b
$ Actuate
ActuateOnRequest
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"onLoad" = Actuate -> XParse Actuate
forall (m :: * -> *) a. Monad m => a -> m a
return (Actuate -> XParse Actuate) -> Actuate -> XParse Actuate
forall a b. (a -> b) -> a -> b
$ Actuate
ActuateOnLoad
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = Actuate -> XParse Actuate
forall (m :: * -> *) a. Monad m => a -> m a
return (Actuate -> XParse Actuate) -> Actuate -> XParse Actuate
forall a b. (a -> b) -> a -> b
$ Actuate
ActuateOther
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = Actuate -> XParse Actuate
forall (m :: * -> *) a. Monad m => a -> m a
return (Actuate -> XParse Actuate) -> Actuate -> XParse Actuate
forall a b. (a -> b) -> a -> b
$ Actuate
ActuateNone
        | Bool
otherwise = String -> XParse Actuate
forall a. String -> XParse a
P.xfail (String -> XParse Actuate) -> String -> XParse Actuate
forall a b. (a -> b) -> a -> b
$ String
"Actuate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @arrow-direction@ /(simple)/
--
-- The arrow-direction type represents the direction in which an arrow points, using Unicode arrow terminology.
data ArrowDirection = 
      ArrowDirectionLeft -- ^ /left/
    | ArrowDirectionUp -- ^ /up/
    | ArrowDirectionRight -- ^ /right/
    | ArrowDirectionDown -- ^ /down/
    | ArrowDirectionNorthwest -- ^ /northwest/
    | ArrowDirectionNortheast -- ^ /northeast/
    | ArrowDirectionSoutheast -- ^ /southeast/
    | ArrowDirectionSouthwest -- ^ /southwest/
    | ArrowDirectionLeftRight -- ^ /left right/
    | ArrowDirectionUpDown -- ^ /up down/
    | ArrowDirectionNorthwestSoutheast -- ^ /northwest southeast/
    | ArrowDirectionNortheastSouthwest -- ^ /northeast southwest/
    | ArrowDirectionOther -- ^ /other/
    deriving (ArrowDirection -> ArrowDirection -> Bool
(ArrowDirection -> ArrowDirection -> Bool)
-> (ArrowDirection -> ArrowDirection -> Bool) -> Eq ArrowDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrowDirection -> ArrowDirection -> Bool
$c/= :: ArrowDirection -> ArrowDirection -> Bool
== :: ArrowDirection -> ArrowDirection -> Bool
$c== :: ArrowDirection -> ArrowDirection -> Bool
Eq,Typeable,(forall x. ArrowDirection -> Rep ArrowDirection x)
-> (forall x. Rep ArrowDirection x -> ArrowDirection)
-> Generic ArrowDirection
forall x. Rep ArrowDirection x -> ArrowDirection
forall x. ArrowDirection -> Rep ArrowDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArrowDirection x -> ArrowDirection
$cfrom :: forall x. ArrowDirection -> Rep ArrowDirection x
Generic,Int -> ArrowDirection -> ShowS
[ArrowDirection] -> ShowS
ArrowDirection -> String
(Int -> ArrowDirection -> ShowS)
-> (ArrowDirection -> String)
-> ([ArrowDirection] -> ShowS)
-> Show ArrowDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrowDirection] -> ShowS
$cshowList :: [ArrowDirection] -> ShowS
show :: ArrowDirection -> String
$cshow :: ArrowDirection -> String
showsPrec :: Int -> ArrowDirection -> ShowS
$cshowsPrec :: Int -> ArrowDirection -> ShowS
Show,Eq ArrowDirection
Eq ArrowDirection
-> (ArrowDirection -> ArrowDirection -> Ordering)
-> (ArrowDirection -> ArrowDirection -> Bool)
-> (ArrowDirection -> ArrowDirection -> Bool)
-> (ArrowDirection -> ArrowDirection -> Bool)
-> (ArrowDirection -> ArrowDirection -> Bool)
-> (ArrowDirection -> ArrowDirection -> ArrowDirection)
-> (ArrowDirection -> ArrowDirection -> ArrowDirection)
-> Ord ArrowDirection
ArrowDirection -> ArrowDirection -> Bool
ArrowDirection -> ArrowDirection -> Ordering
ArrowDirection -> ArrowDirection -> ArrowDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrowDirection -> ArrowDirection -> ArrowDirection
$cmin :: ArrowDirection -> ArrowDirection -> ArrowDirection
max :: ArrowDirection -> ArrowDirection -> ArrowDirection
$cmax :: ArrowDirection -> ArrowDirection -> ArrowDirection
>= :: ArrowDirection -> ArrowDirection -> Bool
$c>= :: ArrowDirection -> ArrowDirection -> Bool
> :: ArrowDirection -> ArrowDirection -> Bool
$c> :: ArrowDirection -> ArrowDirection -> Bool
<= :: ArrowDirection -> ArrowDirection -> Bool
$c<= :: ArrowDirection -> ArrowDirection -> Bool
< :: ArrowDirection -> ArrowDirection -> Bool
$c< :: ArrowDirection -> ArrowDirection -> Bool
compare :: ArrowDirection -> ArrowDirection -> Ordering
$ccompare :: ArrowDirection -> ArrowDirection -> Ordering
$cp1Ord :: Eq ArrowDirection
Ord,Int -> ArrowDirection
ArrowDirection -> Int
ArrowDirection -> [ArrowDirection]
ArrowDirection -> ArrowDirection
ArrowDirection -> ArrowDirection -> [ArrowDirection]
ArrowDirection
-> ArrowDirection -> ArrowDirection -> [ArrowDirection]
(ArrowDirection -> ArrowDirection)
-> (ArrowDirection -> ArrowDirection)
-> (Int -> ArrowDirection)
-> (ArrowDirection -> Int)
-> (ArrowDirection -> [ArrowDirection])
-> (ArrowDirection -> ArrowDirection -> [ArrowDirection])
-> (ArrowDirection -> ArrowDirection -> [ArrowDirection])
-> (ArrowDirection
    -> ArrowDirection -> ArrowDirection -> [ArrowDirection])
-> Enum ArrowDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ArrowDirection
-> ArrowDirection -> ArrowDirection -> [ArrowDirection]
$cenumFromThenTo :: ArrowDirection
-> ArrowDirection -> ArrowDirection -> [ArrowDirection]
enumFromTo :: ArrowDirection -> ArrowDirection -> [ArrowDirection]
$cenumFromTo :: ArrowDirection -> ArrowDirection -> [ArrowDirection]
enumFromThen :: ArrowDirection -> ArrowDirection -> [ArrowDirection]
$cenumFromThen :: ArrowDirection -> ArrowDirection -> [ArrowDirection]
enumFrom :: ArrowDirection -> [ArrowDirection]
$cenumFrom :: ArrowDirection -> [ArrowDirection]
fromEnum :: ArrowDirection -> Int
$cfromEnum :: ArrowDirection -> Int
toEnum :: Int -> ArrowDirection
$ctoEnum :: Int -> ArrowDirection
pred :: ArrowDirection -> ArrowDirection
$cpred :: ArrowDirection -> ArrowDirection
succ :: ArrowDirection -> ArrowDirection
$csucc :: ArrowDirection -> ArrowDirection
Enum,ArrowDirection
ArrowDirection -> ArrowDirection -> Bounded ArrowDirection
forall a. a -> a -> Bounded a
maxBound :: ArrowDirection
$cmaxBound :: ArrowDirection
minBound :: ArrowDirection
$cminBound :: ArrowDirection
Bounded)
instance EmitXml ArrowDirection where
    emitXml :: ArrowDirection -> XmlRep
emitXml ArrowDirection
ArrowDirectionLeft = String -> XmlRep
XLit String
"left"
    emitXml ArrowDirection
ArrowDirectionUp = String -> XmlRep
XLit String
"up"
    emitXml ArrowDirection
ArrowDirectionRight = String -> XmlRep
XLit String
"right"
    emitXml ArrowDirection
ArrowDirectionDown = String -> XmlRep
XLit String
"down"
    emitXml ArrowDirection
ArrowDirectionNorthwest = String -> XmlRep
XLit String
"northwest"
    emitXml ArrowDirection
ArrowDirectionNortheast = String -> XmlRep
XLit String
"northeast"
    emitXml ArrowDirection
ArrowDirectionSoutheast = String -> XmlRep
XLit String
"southeast"
    emitXml ArrowDirection
ArrowDirectionSouthwest = String -> XmlRep
XLit String
"southwest"
    emitXml ArrowDirection
ArrowDirectionLeftRight = String -> XmlRep
XLit String
"left right"
    emitXml ArrowDirection
ArrowDirectionUpDown = String -> XmlRep
XLit String
"up down"
    emitXml ArrowDirection
ArrowDirectionNorthwestSoutheast = String -> XmlRep
XLit String
"northwest southeast"
    emitXml ArrowDirection
ArrowDirectionNortheastSouthwest = String -> XmlRep
XLit String
"northeast southwest"
    emitXml ArrowDirection
ArrowDirectionOther = String -> XmlRep
XLit String
"other"
parseArrowDirection :: String -> P.XParse ArrowDirection
parseArrowDirection :: String -> XParse ArrowDirection
parseArrowDirection String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northwest" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionNorthwest
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northeast" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionNortheast
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"southeast" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionSoutheast
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"southwest" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionSouthwest
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left right" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionLeftRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up down" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionUpDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northwest southeast" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionNorthwestSoutheast
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northeast southwest" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionNortheastSouthwest
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = ArrowDirection -> XParse ArrowDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowDirection -> XParse ArrowDirection)
-> ArrowDirection -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ ArrowDirection
ArrowDirectionOther
        | Bool
otherwise = String -> XParse ArrowDirection
forall a. String -> XParse a
P.xfail (String -> XParse ArrowDirection)
-> String -> XParse ArrowDirection
forall a b. (a -> b) -> a -> b
$ String
"ArrowDirection: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @arrow-style@ /(simple)/
--
-- The arrow-style type represents the style of an arrow, using Unicode arrow terminology. Filled and hollow arrows indicate polygonal single arrows. Paired arrows are duplicate single arrows in the same direction. Combined arrows apply to double direction arrows like left right, indicating that an arrow in one direction should be combined with an arrow in the other direction.
data ArrowStyle = 
      ArrowStyleSingle -- ^ /single/
    | ArrowStyleDouble -- ^ /double/
    | ArrowStyleFilled -- ^ /filled/
    | ArrowStyleHollow -- ^ /hollow/
    | ArrowStylePaired -- ^ /paired/
    | ArrowStyleCombined -- ^ /combined/
    | ArrowStyleOther -- ^ /other/
    deriving (ArrowStyle -> ArrowStyle -> Bool
(ArrowStyle -> ArrowStyle -> Bool)
-> (ArrowStyle -> ArrowStyle -> Bool) -> Eq ArrowStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrowStyle -> ArrowStyle -> Bool
$c/= :: ArrowStyle -> ArrowStyle -> Bool
== :: ArrowStyle -> ArrowStyle -> Bool
$c== :: ArrowStyle -> ArrowStyle -> Bool
Eq,Typeable,(forall x. ArrowStyle -> Rep ArrowStyle x)
-> (forall x. Rep ArrowStyle x -> ArrowStyle) -> Generic ArrowStyle
forall x. Rep ArrowStyle x -> ArrowStyle
forall x. ArrowStyle -> Rep ArrowStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArrowStyle x -> ArrowStyle
$cfrom :: forall x. ArrowStyle -> Rep ArrowStyle x
Generic,Int -> ArrowStyle -> ShowS
[ArrowStyle] -> ShowS
ArrowStyle -> String
(Int -> ArrowStyle -> ShowS)
-> (ArrowStyle -> String)
-> ([ArrowStyle] -> ShowS)
-> Show ArrowStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrowStyle] -> ShowS
$cshowList :: [ArrowStyle] -> ShowS
show :: ArrowStyle -> String
$cshow :: ArrowStyle -> String
showsPrec :: Int -> ArrowStyle -> ShowS
$cshowsPrec :: Int -> ArrowStyle -> ShowS
Show,Eq ArrowStyle
Eq ArrowStyle
-> (ArrowStyle -> ArrowStyle -> Ordering)
-> (ArrowStyle -> ArrowStyle -> Bool)
-> (ArrowStyle -> ArrowStyle -> Bool)
-> (ArrowStyle -> ArrowStyle -> Bool)
-> (ArrowStyle -> ArrowStyle -> Bool)
-> (ArrowStyle -> ArrowStyle -> ArrowStyle)
-> (ArrowStyle -> ArrowStyle -> ArrowStyle)
-> Ord ArrowStyle
ArrowStyle -> ArrowStyle -> Bool
ArrowStyle -> ArrowStyle -> Ordering
ArrowStyle -> ArrowStyle -> ArrowStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrowStyle -> ArrowStyle -> ArrowStyle
$cmin :: ArrowStyle -> ArrowStyle -> ArrowStyle
max :: ArrowStyle -> ArrowStyle -> ArrowStyle
$cmax :: ArrowStyle -> ArrowStyle -> ArrowStyle
>= :: ArrowStyle -> ArrowStyle -> Bool
$c>= :: ArrowStyle -> ArrowStyle -> Bool
> :: ArrowStyle -> ArrowStyle -> Bool
$c> :: ArrowStyle -> ArrowStyle -> Bool
<= :: ArrowStyle -> ArrowStyle -> Bool
$c<= :: ArrowStyle -> ArrowStyle -> Bool
< :: ArrowStyle -> ArrowStyle -> Bool
$c< :: ArrowStyle -> ArrowStyle -> Bool
compare :: ArrowStyle -> ArrowStyle -> Ordering
$ccompare :: ArrowStyle -> ArrowStyle -> Ordering
$cp1Ord :: Eq ArrowStyle
Ord,Int -> ArrowStyle
ArrowStyle -> Int
ArrowStyle -> [ArrowStyle]
ArrowStyle -> ArrowStyle
ArrowStyle -> ArrowStyle -> [ArrowStyle]
ArrowStyle -> ArrowStyle -> ArrowStyle -> [ArrowStyle]
(ArrowStyle -> ArrowStyle)
-> (ArrowStyle -> ArrowStyle)
-> (Int -> ArrowStyle)
-> (ArrowStyle -> Int)
-> (ArrowStyle -> [ArrowStyle])
-> (ArrowStyle -> ArrowStyle -> [ArrowStyle])
-> (ArrowStyle -> ArrowStyle -> [ArrowStyle])
-> (ArrowStyle -> ArrowStyle -> ArrowStyle -> [ArrowStyle])
-> Enum ArrowStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ArrowStyle -> ArrowStyle -> ArrowStyle -> [ArrowStyle]
$cenumFromThenTo :: ArrowStyle -> ArrowStyle -> ArrowStyle -> [ArrowStyle]
enumFromTo :: ArrowStyle -> ArrowStyle -> [ArrowStyle]
$cenumFromTo :: ArrowStyle -> ArrowStyle -> [ArrowStyle]
enumFromThen :: ArrowStyle -> ArrowStyle -> [ArrowStyle]
$cenumFromThen :: ArrowStyle -> ArrowStyle -> [ArrowStyle]
enumFrom :: ArrowStyle -> [ArrowStyle]
$cenumFrom :: ArrowStyle -> [ArrowStyle]
fromEnum :: ArrowStyle -> Int
$cfromEnum :: ArrowStyle -> Int
toEnum :: Int -> ArrowStyle
$ctoEnum :: Int -> ArrowStyle
pred :: ArrowStyle -> ArrowStyle
$cpred :: ArrowStyle -> ArrowStyle
succ :: ArrowStyle -> ArrowStyle
$csucc :: ArrowStyle -> ArrowStyle
Enum,ArrowStyle
ArrowStyle -> ArrowStyle -> Bounded ArrowStyle
forall a. a -> a -> Bounded a
maxBound :: ArrowStyle
$cmaxBound :: ArrowStyle
minBound :: ArrowStyle
$cminBound :: ArrowStyle
Bounded)
instance EmitXml ArrowStyle where
    emitXml :: ArrowStyle -> XmlRep
emitXml ArrowStyle
ArrowStyleSingle = String -> XmlRep
XLit String
"single"
    emitXml ArrowStyle
ArrowStyleDouble = String -> XmlRep
XLit String
"double"
    emitXml ArrowStyle
ArrowStyleFilled = String -> XmlRep
XLit String
"filled"
    emitXml ArrowStyle
ArrowStyleHollow = String -> XmlRep
XLit String
"hollow"
    emitXml ArrowStyle
ArrowStylePaired = String -> XmlRep
XLit String
"paired"
    emitXml ArrowStyle
ArrowStyleCombined = String -> XmlRep
XLit String
"combined"
    emitXml ArrowStyle
ArrowStyleOther = String -> XmlRep
XLit String
"other"
parseArrowStyle :: String -> P.XParse ArrowStyle
parseArrowStyle :: String -> XParse ArrowStyle
parseArrowStyle String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleSingle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleDouble
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"filled" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleFilled
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hollow" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleHollow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"paired" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStylePaired
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"combined" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleCombined
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = ArrowStyle -> XParse ArrowStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrowStyle -> XParse ArrowStyle)
-> ArrowStyle -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ ArrowStyle
ArrowStyleOther
        | Bool
otherwise = String -> XParse ArrowStyle
forall a. String -> XParse a
P.xfail (String -> XParse ArrowStyle) -> String -> XParse ArrowStyle
forall a b. (a -> b) -> a -> b
$ String
"ArrowStyle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @backward-forward@ /(simple)/
--
-- The backward-forward type is used to specify repeat directions. The start of the repeat has a forward direction while the end of the repeat has a backward direction.
data BackwardForward = 
      BackwardForwardBackward -- ^ /backward/
    | BackwardForwardForward -- ^ /forward/
    deriving (BackwardForward -> BackwardForward -> Bool
(BackwardForward -> BackwardForward -> Bool)
-> (BackwardForward -> BackwardForward -> Bool)
-> Eq BackwardForward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackwardForward -> BackwardForward -> Bool
$c/= :: BackwardForward -> BackwardForward -> Bool
== :: BackwardForward -> BackwardForward -> Bool
$c== :: BackwardForward -> BackwardForward -> Bool
Eq,Typeable,(forall x. BackwardForward -> Rep BackwardForward x)
-> (forall x. Rep BackwardForward x -> BackwardForward)
-> Generic BackwardForward
forall x. Rep BackwardForward x -> BackwardForward
forall x. BackwardForward -> Rep BackwardForward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BackwardForward x -> BackwardForward
$cfrom :: forall x. BackwardForward -> Rep BackwardForward x
Generic,Int -> BackwardForward -> ShowS
[BackwardForward] -> ShowS
BackwardForward -> String
(Int -> BackwardForward -> ShowS)
-> (BackwardForward -> String)
-> ([BackwardForward] -> ShowS)
-> Show BackwardForward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackwardForward] -> ShowS
$cshowList :: [BackwardForward] -> ShowS
show :: BackwardForward -> String
$cshow :: BackwardForward -> String
showsPrec :: Int -> BackwardForward -> ShowS
$cshowsPrec :: Int -> BackwardForward -> ShowS
Show,Eq BackwardForward
Eq BackwardForward
-> (BackwardForward -> BackwardForward -> Ordering)
-> (BackwardForward -> BackwardForward -> Bool)
-> (BackwardForward -> BackwardForward -> Bool)
-> (BackwardForward -> BackwardForward -> Bool)
-> (BackwardForward -> BackwardForward -> Bool)
-> (BackwardForward -> BackwardForward -> BackwardForward)
-> (BackwardForward -> BackwardForward -> BackwardForward)
-> Ord BackwardForward
BackwardForward -> BackwardForward -> Bool
BackwardForward -> BackwardForward -> Ordering
BackwardForward -> BackwardForward -> BackwardForward
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BackwardForward -> BackwardForward -> BackwardForward
$cmin :: BackwardForward -> BackwardForward -> BackwardForward
max :: BackwardForward -> BackwardForward -> BackwardForward
$cmax :: BackwardForward -> BackwardForward -> BackwardForward
>= :: BackwardForward -> BackwardForward -> Bool
$c>= :: BackwardForward -> BackwardForward -> Bool
> :: BackwardForward -> BackwardForward -> Bool
$c> :: BackwardForward -> BackwardForward -> Bool
<= :: BackwardForward -> BackwardForward -> Bool
$c<= :: BackwardForward -> BackwardForward -> Bool
< :: BackwardForward -> BackwardForward -> Bool
$c< :: BackwardForward -> BackwardForward -> Bool
compare :: BackwardForward -> BackwardForward -> Ordering
$ccompare :: BackwardForward -> BackwardForward -> Ordering
$cp1Ord :: Eq BackwardForward
Ord,Int -> BackwardForward
BackwardForward -> Int
BackwardForward -> [BackwardForward]
BackwardForward -> BackwardForward
BackwardForward -> BackwardForward -> [BackwardForward]
BackwardForward
-> BackwardForward -> BackwardForward -> [BackwardForward]
(BackwardForward -> BackwardForward)
-> (BackwardForward -> BackwardForward)
-> (Int -> BackwardForward)
-> (BackwardForward -> Int)
-> (BackwardForward -> [BackwardForward])
-> (BackwardForward -> BackwardForward -> [BackwardForward])
-> (BackwardForward -> BackwardForward -> [BackwardForward])
-> (BackwardForward
    -> BackwardForward -> BackwardForward -> [BackwardForward])
-> Enum BackwardForward
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BackwardForward
-> BackwardForward -> BackwardForward -> [BackwardForward]
$cenumFromThenTo :: BackwardForward
-> BackwardForward -> BackwardForward -> [BackwardForward]
enumFromTo :: BackwardForward -> BackwardForward -> [BackwardForward]
$cenumFromTo :: BackwardForward -> BackwardForward -> [BackwardForward]
enumFromThen :: BackwardForward -> BackwardForward -> [BackwardForward]
$cenumFromThen :: BackwardForward -> BackwardForward -> [BackwardForward]
enumFrom :: BackwardForward -> [BackwardForward]
$cenumFrom :: BackwardForward -> [BackwardForward]
fromEnum :: BackwardForward -> Int
$cfromEnum :: BackwardForward -> Int
toEnum :: Int -> BackwardForward
$ctoEnum :: Int -> BackwardForward
pred :: BackwardForward -> BackwardForward
$cpred :: BackwardForward -> BackwardForward
succ :: BackwardForward -> BackwardForward
$csucc :: BackwardForward -> BackwardForward
Enum,BackwardForward
BackwardForward -> BackwardForward -> Bounded BackwardForward
forall a. a -> a -> Bounded a
maxBound :: BackwardForward
$cmaxBound :: BackwardForward
minBound :: BackwardForward
$cminBound :: BackwardForward
Bounded)
instance EmitXml BackwardForward where
    emitXml :: BackwardForward -> XmlRep
emitXml BackwardForward
BackwardForwardBackward = String -> XmlRep
XLit String
"backward"
    emitXml BackwardForward
BackwardForwardForward = String -> XmlRep
XLit String
"forward"
parseBackwardForward :: String -> P.XParse BackwardForward
parseBackwardForward :: String -> XParse BackwardForward
parseBackwardForward String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"backward" = BackwardForward -> XParse BackwardForward
forall (m :: * -> *) a. Monad m => a -> m a
return (BackwardForward -> XParse BackwardForward)
-> BackwardForward -> XParse BackwardForward
forall a b. (a -> b) -> a -> b
$ BackwardForward
BackwardForwardBackward
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"forward" = BackwardForward -> XParse BackwardForward
forall (m :: * -> *) a. Monad m => a -> m a
return (BackwardForward -> XParse BackwardForward)
-> BackwardForward -> XParse BackwardForward
forall a b. (a -> b) -> a -> b
$ BackwardForward
BackwardForwardForward
        | Bool
otherwise = String -> XParse BackwardForward
forall a. String -> XParse a
P.xfail (String -> XParse BackwardForward)
-> String -> XParse BackwardForward
forall a b. (a -> b) -> a -> b
$ String
"BackwardForward: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @bar-style@ /(simple)/
--
-- The bar-style type represents barline style information. Choices are regular, dotted, dashed, heavy, light-light, light-heavy, heavy-light, heavy-heavy, tick (a short stroke through the top line), short (a partial barline between the 2nd and 4th lines), and none.
data BarStyle = 
      BarStyleRegular -- ^ /regular/
    | BarStyleDotted -- ^ /dotted/
    | BarStyleDashed -- ^ /dashed/
    | BarStyleHeavy -- ^ /heavy/
    | BarStyleLightLight -- ^ /light-light/
    | BarStyleLightHeavy -- ^ /light-heavy/
    | BarStyleHeavyLight -- ^ /heavy-light/
    | BarStyleHeavyHeavy -- ^ /heavy-heavy/
    | BarStyleTick -- ^ /tick/
    | BarStyleShort -- ^ /short/
    | BarStyleNone -- ^ /none/
    deriving (BarStyle -> BarStyle -> Bool
(BarStyle -> BarStyle -> Bool)
-> (BarStyle -> BarStyle -> Bool) -> Eq BarStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarStyle -> BarStyle -> Bool
$c/= :: BarStyle -> BarStyle -> Bool
== :: BarStyle -> BarStyle -> Bool
$c== :: BarStyle -> BarStyle -> Bool
Eq,Typeable,(forall x. BarStyle -> Rep BarStyle x)
-> (forall x. Rep BarStyle x -> BarStyle) -> Generic BarStyle
forall x. Rep BarStyle x -> BarStyle
forall x. BarStyle -> Rep BarStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarStyle x -> BarStyle
$cfrom :: forall x. BarStyle -> Rep BarStyle x
Generic,Int -> BarStyle -> ShowS
[BarStyle] -> ShowS
BarStyle -> String
(Int -> BarStyle -> ShowS)
-> (BarStyle -> String) -> ([BarStyle] -> ShowS) -> Show BarStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarStyle] -> ShowS
$cshowList :: [BarStyle] -> ShowS
show :: BarStyle -> String
$cshow :: BarStyle -> String
showsPrec :: Int -> BarStyle -> ShowS
$cshowsPrec :: Int -> BarStyle -> ShowS
Show,Eq BarStyle
Eq BarStyle
-> (BarStyle -> BarStyle -> Ordering)
-> (BarStyle -> BarStyle -> Bool)
-> (BarStyle -> BarStyle -> Bool)
-> (BarStyle -> BarStyle -> Bool)
-> (BarStyle -> BarStyle -> Bool)
-> (BarStyle -> BarStyle -> BarStyle)
-> (BarStyle -> BarStyle -> BarStyle)
-> Ord BarStyle
BarStyle -> BarStyle -> Bool
BarStyle -> BarStyle -> Ordering
BarStyle -> BarStyle -> BarStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BarStyle -> BarStyle -> BarStyle
$cmin :: BarStyle -> BarStyle -> BarStyle
max :: BarStyle -> BarStyle -> BarStyle
$cmax :: BarStyle -> BarStyle -> BarStyle
>= :: BarStyle -> BarStyle -> Bool
$c>= :: BarStyle -> BarStyle -> Bool
> :: BarStyle -> BarStyle -> Bool
$c> :: BarStyle -> BarStyle -> Bool
<= :: BarStyle -> BarStyle -> Bool
$c<= :: BarStyle -> BarStyle -> Bool
< :: BarStyle -> BarStyle -> Bool
$c< :: BarStyle -> BarStyle -> Bool
compare :: BarStyle -> BarStyle -> Ordering
$ccompare :: BarStyle -> BarStyle -> Ordering
$cp1Ord :: Eq BarStyle
Ord,Int -> BarStyle
BarStyle -> Int
BarStyle -> [BarStyle]
BarStyle -> BarStyle
BarStyle -> BarStyle -> [BarStyle]
BarStyle -> BarStyle -> BarStyle -> [BarStyle]
(BarStyle -> BarStyle)
-> (BarStyle -> BarStyle)
-> (Int -> BarStyle)
-> (BarStyle -> Int)
-> (BarStyle -> [BarStyle])
-> (BarStyle -> BarStyle -> [BarStyle])
-> (BarStyle -> BarStyle -> [BarStyle])
-> (BarStyle -> BarStyle -> BarStyle -> [BarStyle])
-> Enum BarStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BarStyle -> BarStyle -> BarStyle -> [BarStyle]
$cenumFromThenTo :: BarStyle -> BarStyle -> BarStyle -> [BarStyle]
enumFromTo :: BarStyle -> BarStyle -> [BarStyle]
$cenumFromTo :: BarStyle -> BarStyle -> [BarStyle]
enumFromThen :: BarStyle -> BarStyle -> [BarStyle]
$cenumFromThen :: BarStyle -> BarStyle -> [BarStyle]
enumFrom :: BarStyle -> [BarStyle]
$cenumFrom :: BarStyle -> [BarStyle]
fromEnum :: BarStyle -> Int
$cfromEnum :: BarStyle -> Int
toEnum :: Int -> BarStyle
$ctoEnum :: Int -> BarStyle
pred :: BarStyle -> BarStyle
$cpred :: BarStyle -> BarStyle
succ :: BarStyle -> BarStyle
$csucc :: BarStyle -> BarStyle
Enum,BarStyle
BarStyle -> BarStyle -> Bounded BarStyle
forall a. a -> a -> Bounded a
maxBound :: BarStyle
$cmaxBound :: BarStyle
minBound :: BarStyle
$cminBound :: BarStyle
Bounded)
instance EmitXml BarStyle where
    emitXml :: BarStyle -> XmlRep
emitXml BarStyle
BarStyleRegular = String -> XmlRep
XLit String
"regular"
    emitXml BarStyle
BarStyleDotted = String -> XmlRep
XLit String
"dotted"
    emitXml BarStyle
BarStyleDashed = String -> XmlRep
XLit String
"dashed"
    emitXml BarStyle
BarStyleHeavy = String -> XmlRep
XLit String
"heavy"
    emitXml BarStyle
BarStyleLightLight = String -> XmlRep
XLit String
"light-light"
    emitXml BarStyle
BarStyleLightHeavy = String -> XmlRep
XLit String
"light-heavy"
    emitXml BarStyle
BarStyleHeavyLight = String -> XmlRep
XLit String
"heavy-light"
    emitXml BarStyle
BarStyleHeavyHeavy = String -> XmlRep
XLit String
"heavy-heavy"
    emitXml BarStyle
BarStyleTick = String -> XmlRep
XLit String
"tick"
    emitXml BarStyle
BarStyleShort = String -> XmlRep
XLit String
"short"
    emitXml BarStyle
BarStyleNone = String -> XmlRep
XLit String
"none"
parseBarStyle :: String -> P.XParse BarStyle
parseBarStyle :: String -> XParse BarStyle
parseBarStyle String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"regular" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleRegular
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dotted" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleDotted
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dashed" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleDashed
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"heavy" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleHeavy
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"light-light" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleLightLight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"light-heavy" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleLightHeavy
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"heavy-light" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleHeavyLight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"heavy-heavy" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleHeavyHeavy
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tick" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleTick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"short" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleShort
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = BarStyle -> XParse BarStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (BarStyle -> XParse BarStyle) -> BarStyle -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ BarStyle
BarStyleNone
        | Bool
otherwise = String -> XParse BarStyle
forall a. String -> XParse a
P.xfail (String -> XParse BarStyle) -> String -> XParse BarStyle
forall a b. (a -> b) -> a -> b
$ String
"BarStyle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @beam-level@ /(simple)/
--
-- The MusicXML format supports six levels of beaming, up to 1024th notes. Unlike the number-level type, the beam-level type identifies concurrent beams in a beam group. It does not distinguish overlapping beams such as grace notes within regular notes, or beams used in different voices.
newtype BeamLevel = BeamLevel { BeamLevel -> PositiveInteger
beamLevel :: PositiveInteger }
    deriving (BeamLevel -> BeamLevel -> Bool
(BeamLevel -> BeamLevel -> Bool)
-> (BeamLevel -> BeamLevel -> Bool) -> Eq BeamLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeamLevel -> BeamLevel -> Bool
$c/= :: BeamLevel -> BeamLevel -> Bool
== :: BeamLevel -> BeamLevel -> Bool
$c== :: BeamLevel -> BeamLevel -> Bool
Eq,Typeable,(forall x. BeamLevel -> Rep BeamLevel x)
-> (forall x. Rep BeamLevel x -> BeamLevel) -> Generic BeamLevel
forall x. Rep BeamLevel x -> BeamLevel
forall x. BeamLevel -> Rep BeamLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeamLevel x -> BeamLevel
$cfrom :: forall x. BeamLevel -> Rep BeamLevel x
Generic,Eq BeamLevel
Eq BeamLevel
-> (BeamLevel -> BeamLevel -> Ordering)
-> (BeamLevel -> BeamLevel -> Bool)
-> (BeamLevel -> BeamLevel -> Bool)
-> (BeamLevel -> BeamLevel -> Bool)
-> (BeamLevel -> BeamLevel -> Bool)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> Ord BeamLevel
BeamLevel -> BeamLevel -> Bool
BeamLevel -> BeamLevel -> Ordering
BeamLevel -> BeamLevel -> BeamLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeamLevel -> BeamLevel -> BeamLevel
$cmin :: BeamLevel -> BeamLevel -> BeamLevel
max :: BeamLevel -> BeamLevel -> BeamLevel
$cmax :: BeamLevel -> BeamLevel -> BeamLevel
>= :: BeamLevel -> BeamLevel -> Bool
$c>= :: BeamLevel -> BeamLevel -> Bool
> :: BeamLevel -> BeamLevel -> Bool
$c> :: BeamLevel -> BeamLevel -> Bool
<= :: BeamLevel -> BeamLevel -> Bool
$c<= :: BeamLevel -> BeamLevel -> Bool
< :: BeamLevel -> BeamLevel -> Bool
$c< :: BeamLevel -> BeamLevel -> Bool
compare :: BeamLevel -> BeamLevel -> Ordering
$ccompare :: BeamLevel -> BeamLevel -> Ordering
$cp1Ord :: Eq BeamLevel
Ord,BeamLevel
BeamLevel -> BeamLevel -> Bounded BeamLevel
forall a. a -> a -> Bounded a
maxBound :: BeamLevel
$cmaxBound :: BeamLevel
minBound :: BeamLevel
$cminBound :: BeamLevel
Bounded,Int -> BeamLevel
BeamLevel -> Int
BeamLevel -> [BeamLevel]
BeamLevel -> BeamLevel
BeamLevel -> BeamLevel -> [BeamLevel]
BeamLevel -> BeamLevel -> BeamLevel -> [BeamLevel]
(BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel)
-> (Int -> BeamLevel)
-> (BeamLevel -> Int)
-> (BeamLevel -> [BeamLevel])
-> (BeamLevel -> BeamLevel -> [BeamLevel])
-> (BeamLevel -> BeamLevel -> [BeamLevel])
-> (BeamLevel -> BeamLevel -> BeamLevel -> [BeamLevel])
-> Enum BeamLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BeamLevel -> BeamLevel -> BeamLevel -> [BeamLevel]
$cenumFromThenTo :: BeamLevel -> BeamLevel -> BeamLevel -> [BeamLevel]
enumFromTo :: BeamLevel -> BeamLevel -> [BeamLevel]
$cenumFromTo :: BeamLevel -> BeamLevel -> [BeamLevel]
enumFromThen :: BeamLevel -> BeamLevel -> [BeamLevel]
$cenumFromThen :: BeamLevel -> BeamLevel -> [BeamLevel]
enumFrom :: BeamLevel -> [BeamLevel]
$cenumFrom :: BeamLevel -> [BeamLevel]
fromEnum :: BeamLevel -> Int
$cfromEnum :: BeamLevel -> Int
toEnum :: Int -> BeamLevel
$ctoEnum :: Int -> BeamLevel
pred :: BeamLevel -> BeamLevel
$cpred :: BeamLevel -> BeamLevel
succ :: BeamLevel -> BeamLevel
$csucc :: BeamLevel -> BeamLevel
Enum,Integer -> BeamLevel
BeamLevel -> BeamLevel
BeamLevel -> BeamLevel -> BeamLevel
(BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel)
-> (Integer -> BeamLevel)
-> Num BeamLevel
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BeamLevel
$cfromInteger :: Integer -> BeamLevel
signum :: BeamLevel -> BeamLevel
$csignum :: BeamLevel -> BeamLevel
abs :: BeamLevel -> BeamLevel
$cabs :: BeamLevel -> BeamLevel
negate :: BeamLevel -> BeamLevel
$cnegate :: BeamLevel -> BeamLevel
* :: BeamLevel -> BeamLevel -> BeamLevel
$c* :: BeamLevel -> BeamLevel -> BeamLevel
- :: BeamLevel -> BeamLevel -> BeamLevel
$c- :: BeamLevel -> BeamLevel -> BeamLevel
+ :: BeamLevel -> BeamLevel -> BeamLevel
$c+ :: BeamLevel -> BeamLevel -> BeamLevel
Num,Num BeamLevel
Ord BeamLevel
Num BeamLevel
-> Ord BeamLevel -> (BeamLevel -> Rational) -> Real BeamLevel
BeamLevel -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: BeamLevel -> Rational
$ctoRational :: BeamLevel -> Rational
$cp2Real :: Ord BeamLevel
$cp1Real :: Num BeamLevel
Real,Enum BeamLevel
Real BeamLevel
Real BeamLevel
-> Enum BeamLevel
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> BeamLevel)
-> (BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel))
-> (BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel))
-> (BeamLevel -> Integer)
-> Integral BeamLevel
BeamLevel -> Integer
BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel)
BeamLevel -> BeamLevel -> BeamLevel
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: BeamLevel -> Integer
$ctoInteger :: BeamLevel -> Integer
divMod :: BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel)
$cdivMod :: BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel)
quotRem :: BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel)
$cquotRem :: BeamLevel -> BeamLevel -> (BeamLevel, BeamLevel)
mod :: BeamLevel -> BeamLevel -> BeamLevel
$cmod :: BeamLevel -> BeamLevel -> BeamLevel
div :: BeamLevel -> BeamLevel -> BeamLevel
$cdiv :: BeamLevel -> BeamLevel -> BeamLevel
rem :: BeamLevel -> BeamLevel -> BeamLevel
$crem :: BeamLevel -> BeamLevel -> BeamLevel
quot :: BeamLevel -> BeamLevel -> BeamLevel
$cquot :: BeamLevel -> BeamLevel -> BeamLevel
$cp2Integral :: Enum BeamLevel
$cp1Integral :: Real BeamLevel
Integral)
instance Show BeamLevel where show :: BeamLevel -> String
show (BeamLevel PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read BeamLevel where readsPrec :: Int -> ReadS BeamLevel
readsPrec Int
i = ((PositiveInteger, String) -> (BeamLevel, String))
-> [(PositiveInteger, String)] -> [(BeamLevel, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> BeamLevel)
-> (PositiveInteger, String) -> (BeamLevel, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> BeamLevel
BeamLevel) ([(PositiveInteger, String)] -> [(BeamLevel, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS BeamLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml BeamLevel where
    emitXml :: BeamLevel -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (BeamLevel -> PositiveInteger) -> BeamLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamLevel -> PositiveInteger
beamLevel
parseBeamLevel :: String -> P.XParse BeamLevel
parseBeamLevel :: String -> XParse BeamLevel
parseBeamLevel = String -> String -> XParse BeamLevel
forall a. Read a => String -> String -> XParse a
P.xread String
"BeamLevel"

-- | @beam-value@ /(simple)/
--
-- The beam-value type represents the type of beam associated with each of 8 beam levels (up to 1024th notes) available for each note.
data BeamValue = 
      BeamValueBegin -- ^ /begin/
    | BeamValueContinue -- ^ /continue/
    | BeamValueEnd -- ^ /end/
    | BeamValueForwardHook -- ^ /forward hook/
    | BeamValueBackwardHook -- ^ /backward hook/
    deriving (BeamValue -> BeamValue -> Bool
(BeamValue -> BeamValue -> Bool)
-> (BeamValue -> BeamValue -> Bool) -> Eq BeamValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeamValue -> BeamValue -> Bool
$c/= :: BeamValue -> BeamValue -> Bool
== :: BeamValue -> BeamValue -> Bool
$c== :: BeamValue -> BeamValue -> Bool
Eq,Typeable,(forall x. BeamValue -> Rep BeamValue x)
-> (forall x. Rep BeamValue x -> BeamValue) -> Generic BeamValue
forall x. Rep BeamValue x -> BeamValue
forall x. BeamValue -> Rep BeamValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeamValue x -> BeamValue
$cfrom :: forall x. BeamValue -> Rep BeamValue x
Generic,Int -> BeamValue -> ShowS
[BeamValue] -> ShowS
BeamValue -> String
(Int -> BeamValue -> ShowS)
-> (BeamValue -> String)
-> ([BeamValue] -> ShowS)
-> Show BeamValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeamValue] -> ShowS
$cshowList :: [BeamValue] -> ShowS
show :: BeamValue -> String
$cshow :: BeamValue -> String
showsPrec :: Int -> BeamValue -> ShowS
$cshowsPrec :: Int -> BeamValue -> ShowS
Show,Eq BeamValue
Eq BeamValue
-> (BeamValue -> BeamValue -> Ordering)
-> (BeamValue -> BeamValue -> Bool)
-> (BeamValue -> BeamValue -> Bool)
-> (BeamValue -> BeamValue -> Bool)
-> (BeamValue -> BeamValue -> Bool)
-> (BeamValue -> BeamValue -> BeamValue)
-> (BeamValue -> BeamValue -> BeamValue)
-> Ord BeamValue
BeamValue -> BeamValue -> Bool
BeamValue -> BeamValue -> Ordering
BeamValue -> BeamValue -> BeamValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeamValue -> BeamValue -> BeamValue
$cmin :: BeamValue -> BeamValue -> BeamValue
max :: BeamValue -> BeamValue -> BeamValue
$cmax :: BeamValue -> BeamValue -> BeamValue
>= :: BeamValue -> BeamValue -> Bool
$c>= :: BeamValue -> BeamValue -> Bool
> :: BeamValue -> BeamValue -> Bool
$c> :: BeamValue -> BeamValue -> Bool
<= :: BeamValue -> BeamValue -> Bool
$c<= :: BeamValue -> BeamValue -> Bool
< :: BeamValue -> BeamValue -> Bool
$c< :: BeamValue -> BeamValue -> Bool
compare :: BeamValue -> BeamValue -> Ordering
$ccompare :: BeamValue -> BeamValue -> Ordering
$cp1Ord :: Eq BeamValue
Ord,Int -> BeamValue
BeamValue -> Int
BeamValue -> [BeamValue]
BeamValue -> BeamValue
BeamValue -> BeamValue -> [BeamValue]
BeamValue -> BeamValue -> BeamValue -> [BeamValue]
(BeamValue -> BeamValue)
-> (BeamValue -> BeamValue)
-> (Int -> BeamValue)
-> (BeamValue -> Int)
-> (BeamValue -> [BeamValue])
-> (BeamValue -> BeamValue -> [BeamValue])
-> (BeamValue -> BeamValue -> [BeamValue])
-> (BeamValue -> BeamValue -> BeamValue -> [BeamValue])
-> Enum BeamValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BeamValue -> BeamValue -> BeamValue -> [BeamValue]
$cenumFromThenTo :: BeamValue -> BeamValue -> BeamValue -> [BeamValue]
enumFromTo :: BeamValue -> BeamValue -> [BeamValue]
$cenumFromTo :: BeamValue -> BeamValue -> [BeamValue]
enumFromThen :: BeamValue -> BeamValue -> [BeamValue]
$cenumFromThen :: BeamValue -> BeamValue -> [BeamValue]
enumFrom :: BeamValue -> [BeamValue]
$cenumFrom :: BeamValue -> [BeamValue]
fromEnum :: BeamValue -> Int
$cfromEnum :: BeamValue -> Int
toEnum :: Int -> BeamValue
$ctoEnum :: Int -> BeamValue
pred :: BeamValue -> BeamValue
$cpred :: BeamValue -> BeamValue
succ :: BeamValue -> BeamValue
$csucc :: BeamValue -> BeamValue
Enum,BeamValue
BeamValue -> BeamValue -> Bounded BeamValue
forall a. a -> a -> Bounded a
maxBound :: BeamValue
$cmaxBound :: BeamValue
minBound :: BeamValue
$cminBound :: BeamValue
Bounded)
instance EmitXml BeamValue where
    emitXml :: BeamValue -> XmlRep
emitXml BeamValue
BeamValueBegin = String -> XmlRep
XLit String
"begin"
    emitXml BeamValue
BeamValueContinue = String -> XmlRep
XLit String
"continue"
    emitXml BeamValue
BeamValueEnd = String -> XmlRep
XLit String
"end"
    emitXml BeamValue
BeamValueForwardHook = String -> XmlRep
XLit String
"forward hook"
    emitXml BeamValue
BeamValueBackwardHook = String -> XmlRep
XLit String
"backward hook"
parseBeamValue :: String -> P.XParse BeamValue
parseBeamValue :: String -> XParse BeamValue
parseBeamValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"begin" = BeamValue -> XParse BeamValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeamValue -> XParse BeamValue) -> BeamValue -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ BeamValue
BeamValueBegin
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = BeamValue -> XParse BeamValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeamValue -> XParse BeamValue) -> BeamValue -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ BeamValue
BeamValueContinue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"end" = BeamValue -> XParse BeamValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeamValue -> XParse BeamValue) -> BeamValue -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ BeamValue
BeamValueEnd
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"forward hook" = BeamValue -> XParse BeamValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeamValue -> XParse BeamValue) -> BeamValue -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ BeamValue
BeamValueForwardHook
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"backward hook" = BeamValue -> XParse BeamValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeamValue -> XParse BeamValue) -> BeamValue -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ BeamValue
BeamValueBackwardHook
        | Bool
otherwise = String -> XParse BeamValue
forall a. String -> XParse a
P.xfail (String -> XParse BeamValue) -> String -> XParse BeamValue
forall a b. (a -> b) -> a -> b
$ String
"BeamValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @beater-value@ /(simple)/
--
-- The beater-value type represents pictograms for beaters, mallets, and sticks that do not have different materials represented in the pictogram. The finger and hammer values are in addition to Stone's list.
data BeaterValue = 
      BeaterValueBow -- ^ /bow/
    | BeaterValueChimeHammer -- ^ /chime hammer/
    | BeaterValueCoin -- ^ /coin/
    | BeaterValueDrumStick -- ^ /drum stick/
    | BeaterValueFinger -- ^ /finger/
    | BeaterValueFingernail -- ^ /fingernail/
    | BeaterValueFist -- ^ /fist/
    | BeaterValueGuiroScraper -- ^ /guiro scraper/
    | BeaterValueHammer -- ^ /hammer/
    | BeaterValueHand -- ^ /hand/
    | BeaterValueJazzStick -- ^ /jazz stick/
    | BeaterValueKnittingNeedle -- ^ /knitting needle/
    | BeaterValueMetalHammer -- ^ /metal hammer/
    | BeaterValueSlideBrushOnGong -- ^ /slide brush on gong/
    | BeaterValueSnareStick -- ^ /snare stick/
    | BeaterValueSpoonMallet -- ^ /spoon mallet/
    | BeaterValueSuperball -- ^ /superball/
    | BeaterValueTriangleBeater -- ^ /triangle beater/
    | BeaterValueTriangleBeaterPlain -- ^ /triangle beater plain/
    | BeaterValueWireBrush -- ^ /wire brush/
    deriving (BeaterValue -> BeaterValue -> Bool
(BeaterValue -> BeaterValue -> Bool)
-> (BeaterValue -> BeaterValue -> Bool) -> Eq BeaterValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeaterValue -> BeaterValue -> Bool
$c/= :: BeaterValue -> BeaterValue -> Bool
== :: BeaterValue -> BeaterValue -> Bool
$c== :: BeaterValue -> BeaterValue -> Bool
Eq,Typeable,(forall x. BeaterValue -> Rep BeaterValue x)
-> (forall x. Rep BeaterValue x -> BeaterValue)
-> Generic BeaterValue
forall x. Rep BeaterValue x -> BeaterValue
forall x. BeaterValue -> Rep BeaterValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeaterValue x -> BeaterValue
$cfrom :: forall x. BeaterValue -> Rep BeaterValue x
Generic,Int -> BeaterValue -> ShowS
[BeaterValue] -> ShowS
BeaterValue -> String
(Int -> BeaterValue -> ShowS)
-> (BeaterValue -> String)
-> ([BeaterValue] -> ShowS)
-> Show BeaterValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeaterValue] -> ShowS
$cshowList :: [BeaterValue] -> ShowS
show :: BeaterValue -> String
$cshow :: BeaterValue -> String
showsPrec :: Int -> BeaterValue -> ShowS
$cshowsPrec :: Int -> BeaterValue -> ShowS
Show,Eq BeaterValue
Eq BeaterValue
-> (BeaterValue -> BeaterValue -> Ordering)
-> (BeaterValue -> BeaterValue -> Bool)
-> (BeaterValue -> BeaterValue -> Bool)
-> (BeaterValue -> BeaterValue -> Bool)
-> (BeaterValue -> BeaterValue -> Bool)
-> (BeaterValue -> BeaterValue -> BeaterValue)
-> (BeaterValue -> BeaterValue -> BeaterValue)
-> Ord BeaterValue
BeaterValue -> BeaterValue -> Bool
BeaterValue -> BeaterValue -> Ordering
BeaterValue -> BeaterValue -> BeaterValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeaterValue -> BeaterValue -> BeaterValue
$cmin :: BeaterValue -> BeaterValue -> BeaterValue
max :: BeaterValue -> BeaterValue -> BeaterValue
$cmax :: BeaterValue -> BeaterValue -> BeaterValue
>= :: BeaterValue -> BeaterValue -> Bool
$c>= :: BeaterValue -> BeaterValue -> Bool
> :: BeaterValue -> BeaterValue -> Bool
$c> :: BeaterValue -> BeaterValue -> Bool
<= :: BeaterValue -> BeaterValue -> Bool
$c<= :: BeaterValue -> BeaterValue -> Bool
< :: BeaterValue -> BeaterValue -> Bool
$c< :: BeaterValue -> BeaterValue -> Bool
compare :: BeaterValue -> BeaterValue -> Ordering
$ccompare :: BeaterValue -> BeaterValue -> Ordering
$cp1Ord :: Eq BeaterValue
Ord,Int -> BeaterValue
BeaterValue -> Int
BeaterValue -> [BeaterValue]
BeaterValue -> BeaterValue
BeaterValue -> BeaterValue -> [BeaterValue]
BeaterValue -> BeaterValue -> BeaterValue -> [BeaterValue]
(BeaterValue -> BeaterValue)
-> (BeaterValue -> BeaterValue)
-> (Int -> BeaterValue)
-> (BeaterValue -> Int)
-> (BeaterValue -> [BeaterValue])
-> (BeaterValue -> BeaterValue -> [BeaterValue])
-> (BeaterValue -> BeaterValue -> [BeaterValue])
-> (BeaterValue -> BeaterValue -> BeaterValue -> [BeaterValue])
-> Enum BeaterValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BeaterValue -> BeaterValue -> BeaterValue -> [BeaterValue]
$cenumFromThenTo :: BeaterValue -> BeaterValue -> BeaterValue -> [BeaterValue]
enumFromTo :: BeaterValue -> BeaterValue -> [BeaterValue]
$cenumFromTo :: BeaterValue -> BeaterValue -> [BeaterValue]
enumFromThen :: BeaterValue -> BeaterValue -> [BeaterValue]
$cenumFromThen :: BeaterValue -> BeaterValue -> [BeaterValue]
enumFrom :: BeaterValue -> [BeaterValue]
$cenumFrom :: BeaterValue -> [BeaterValue]
fromEnum :: BeaterValue -> Int
$cfromEnum :: BeaterValue -> Int
toEnum :: Int -> BeaterValue
$ctoEnum :: Int -> BeaterValue
pred :: BeaterValue -> BeaterValue
$cpred :: BeaterValue -> BeaterValue
succ :: BeaterValue -> BeaterValue
$csucc :: BeaterValue -> BeaterValue
Enum,BeaterValue
BeaterValue -> BeaterValue -> Bounded BeaterValue
forall a. a -> a -> Bounded a
maxBound :: BeaterValue
$cmaxBound :: BeaterValue
minBound :: BeaterValue
$cminBound :: BeaterValue
Bounded)
instance EmitXml BeaterValue where
    emitXml :: BeaterValue -> XmlRep
emitXml BeaterValue
BeaterValueBow = String -> XmlRep
XLit String
"bow"
    emitXml BeaterValue
BeaterValueChimeHammer = String -> XmlRep
XLit String
"chime hammer"
    emitXml BeaterValue
BeaterValueCoin = String -> XmlRep
XLit String
"coin"
    emitXml BeaterValue
BeaterValueDrumStick = String -> XmlRep
XLit String
"drum stick"
    emitXml BeaterValue
BeaterValueFinger = String -> XmlRep
XLit String
"finger"
    emitXml BeaterValue
BeaterValueFingernail = String -> XmlRep
XLit String
"fingernail"
    emitXml BeaterValue
BeaterValueFist = String -> XmlRep
XLit String
"fist"
    emitXml BeaterValue
BeaterValueGuiroScraper = String -> XmlRep
XLit String
"guiro scraper"
    emitXml BeaterValue
BeaterValueHammer = String -> XmlRep
XLit String
"hammer"
    emitXml BeaterValue
BeaterValueHand = String -> XmlRep
XLit String
"hand"
    emitXml BeaterValue
BeaterValueJazzStick = String -> XmlRep
XLit String
"jazz stick"
    emitXml BeaterValue
BeaterValueKnittingNeedle = String -> XmlRep
XLit String
"knitting needle"
    emitXml BeaterValue
BeaterValueMetalHammer = String -> XmlRep
XLit String
"metal hammer"
    emitXml BeaterValue
BeaterValueSlideBrushOnGong = String -> XmlRep
XLit String
"slide brush on gong"
    emitXml BeaterValue
BeaterValueSnareStick = String -> XmlRep
XLit String
"snare stick"
    emitXml BeaterValue
BeaterValueSpoonMallet = String -> XmlRep
XLit String
"spoon mallet"
    emitXml BeaterValue
BeaterValueSuperball = String -> XmlRep
XLit String
"superball"
    emitXml BeaterValue
BeaterValueTriangleBeater = String -> XmlRep
XLit String
"triangle beater"
    emitXml BeaterValue
BeaterValueTriangleBeaterPlain = String -> XmlRep
XLit String
"triangle beater plain"
    emitXml BeaterValue
BeaterValueWireBrush = String -> XmlRep
XLit String
"wire brush"
parseBeaterValue :: String -> P.XParse BeaterValue
parseBeaterValue :: String -> XParse BeaterValue
parseBeaterValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bow" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueBow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"chime hammer" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueChimeHammer
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"coin" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueCoin
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"drum stick" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueDrumStick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"finger" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueFinger
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fingernail" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueFingernail
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fist" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueFist
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"guiro scraper" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueGuiroScraper
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hammer" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueHammer
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hand" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueHand
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"jazz stick" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueJazzStick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"knitting needle" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueKnittingNeedle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"metal hammer" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueMetalHammer
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slide brush on gong" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueSlideBrushOnGong
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"snare stick" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueSnareStick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"spoon mallet" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueSpoonMallet
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"superball" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueSuperball
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triangle beater" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueTriangleBeater
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triangle beater plain" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueTriangleBeaterPlain
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wire brush" = BeaterValue -> XParse BeaterValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BeaterValue -> XParse BeaterValue)
-> BeaterValue -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ BeaterValue
BeaterValueWireBrush
        | Bool
otherwise = String -> XParse BeaterValue
forall a. String -> XParse a
P.xfail (String -> XParse BeaterValue) -> String -> XParse BeaterValue
forall a b. (a -> b) -> a -> b
$ String
"BeaterValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @breath-mark-value@ /(simple)/
--
-- The breath-mark-value type represents the symbol used for a breath mark.
data BreathMarkValue = 
      BreathMarkValue -- ^ //
    | BreathMarkValueComma -- ^ /comma/
    | BreathMarkValueTick -- ^ /tick/
    | BreathMarkValueUpbow -- ^ /upbow/
    | BreathMarkValueSalzedo -- ^ /salzedo/
    deriving (BreathMarkValue -> BreathMarkValue -> Bool
(BreathMarkValue -> BreathMarkValue -> Bool)
-> (BreathMarkValue -> BreathMarkValue -> Bool)
-> Eq BreathMarkValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreathMarkValue -> BreathMarkValue -> Bool
$c/= :: BreathMarkValue -> BreathMarkValue -> Bool
== :: BreathMarkValue -> BreathMarkValue -> Bool
$c== :: BreathMarkValue -> BreathMarkValue -> Bool
Eq,Typeable,(forall x. BreathMarkValue -> Rep BreathMarkValue x)
-> (forall x. Rep BreathMarkValue x -> BreathMarkValue)
-> Generic BreathMarkValue
forall x. Rep BreathMarkValue x -> BreathMarkValue
forall x. BreathMarkValue -> Rep BreathMarkValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BreathMarkValue x -> BreathMarkValue
$cfrom :: forall x. BreathMarkValue -> Rep BreathMarkValue x
Generic,Int -> BreathMarkValue -> ShowS
[BreathMarkValue] -> ShowS
BreathMarkValue -> String
(Int -> BreathMarkValue -> ShowS)
-> (BreathMarkValue -> String)
-> ([BreathMarkValue] -> ShowS)
-> Show BreathMarkValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreathMarkValue] -> ShowS
$cshowList :: [BreathMarkValue] -> ShowS
show :: BreathMarkValue -> String
$cshow :: BreathMarkValue -> String
showsPrec :: Int -> BreathMarkValue -> ShowS
$cshowsPrec :: Int -> BreathMarkValue -> ShowS
Show,Eq BreathMarkValue
Eq BreathMarkValue
-> (BreathMarkValue -> BreathMarkValue -> Ordering)
-> (BreathMarkValue -> BreathMarkValue -> Bool)
-> (BreathMarkValue -> BreathMarkValue -> Bool)
-> (BreathMarkValue -> BreathMarkValue -> Bool)
-> (BreathMarkValue -> BreathMarkValue -> Bool)
-> (BreathMarkValue -> BreathMarkValue -> BreathMarkValue)
-> (BreathMarkValue -> BreathMarkValue -> BreathMarkValue)
-> Ord BreathMarkValue
BreathMarkValue -> BreathMarkValue -> Bool
BreathMarkValue -> BreathMarkValue -> Ordering
BreathMarkValue -> BreathMarkValue -> BreathMarkValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BreathMarkValue -> BreathMarkValue -> BreathMarkValue
$cmin :: BreathMarkValue -> BreathMarkValue -> BreathMarkValue
max :: BreathMarkValue -> BreathMarkValue -> BreathMarkValue
$cmax :: BreathMarkValue -> BreathMarkValue -> BreathMarkValue
>= :: BreathMarkValue -> BreathMarkValue -> Bool
$c>= :: BreathMarkValue -> BreathMarkValue -> Bool
> :: BreathMarkValue -> BreathMarkValue -> Bool
$c> :: BreathMarkValue -> BreathMarkValue -> Bool
<= :: BreathMarkValue -> BreathMarkValue -> Bool
$c<= :: BreathMarkValue -> BreathMarkValue -> Bool
< :: BreathMarkValue -> BreathMarkValue -> Bool
$c< :: BreathMarkValue -> BreathMarkValue -> Bool
compare :: BreathMarkValue -> BreathMarkValue -> Ordering
$ccompare :: BreathMarkValue -> BreathMarkValue -> Ordering
$cp1Ord :: Eq BreathMarkValue
Ord,Int -> BreathMarkValue
BreathMarkValue -> Int
BreathMarkValue -> [BreathMarkValue]
BreathMarkValue -> BreathMarkValue
BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
BreathMarkValue
-> BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
(BreathMarkValue -> BreathMarkValue)
-> (BreathMarkValue -> BreathMarkValue)
-> (Int -> BreathMarkValue)
-> (BreathMarkValue -> Int)
-> (BreathMarkValue -> [BreathMarkValue])
-> (BreathMarkValue -> BreathMarkValue -> [BreathMarkValue])
-> (BreathMarkValue -> BreathMarkValue -> [BreathMarkValue])
-> (BreathMarkValue
    -> BreathMarkValue -> BreathMarkValue -> [BreathMarkValue])
-> Enum BreathMarkValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BreathMarkValue
-> BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
$cenumFromThenTo :: BreathMarkValue
-> BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
enumFromTo :: BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
$cenumFromTo :: BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
enumFromThen :: BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
$cenumFromThen :: BreathMarkValue -> BreathMarkValue -> [BreathMarkValue]
enumFrom :: BreathMarkValue -> [BreathMarkValue]
$cenumFrom :: BreathMarkValue -> [BreathMarkValue]
fromEnum :: BreathMarkValue -> Int
$cfromEnum :: BreathMarkValue -> Int
toEnum :: Int -> BreathMarkValue
$ctoEnum :: Int -> BreathMarkValue
pred :: BreathMarkValue -> BreathMarkValue
$cpred :: BreathMarkValue -> BreathMarkValue
succ :: BreathMarkValue -> BreathMarkValue
$csucc :: BreathMarkValue -> BreathMarkValue
Enum,BreathMarkValue
BreathMarkValue -> BreathMarkValue -> Bounded BreathMarkValue
forall a. a -> a -> Bounded a
maxBound :: BreathMarkValue
$cmaxBound :: BreathMarkValue
minBound :: BreathMarkValue
$cminBound :: BreathMarkValue
Bounded)
instance EmitXml BreathMarkValue where
    emitXml :: BreathMarkValue -> XmlRep
emitXml BreathMarkValue
BreathMarkValue = String -> XmlRep
XLit String
""
    emitXml BreathMarkValue
BreathMarkValueComma = String -> XmlRep
XLit String
"comma"
    emitXml BreathMarkValue
BreathMarkValueTick = String -> XmlRep
XLit String
"tick"
    emitXml BreathMarkValue
BreathMarkValueUpbow = String -> XmlRep
XLit String
"upbow"
    emitXml BreathMarkValue
BreathMarkValueSalzedo = String -> XmlRep
XLit String
"salzedo"
parseBreathMarkValue :: String -> P.XParse BreathMarkValue
parseBreathMarkValue :: String -> XParse BreathMarkValue
parseBreathMarkValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = BreathMarkValue -> XParse BreathMarkValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BreathMarkValue -> XParse BreathMarkValue)
-> BreathMarkValue -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ BreathMarkValue
BreathMarkValue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"comma" = BreathMarkValue -> XParse BreathMarkValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BreathMarkValue -> XParse BreathMarkValue)
-> BreathMarkValue -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ BreathMarkValue
BreathMarkValueComma
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tick" = BreathMarkValue -> XParse BreathMarkValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BreathMarkValue -> XParse BreathMarkValue)
-> BreathMarkValue -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ BreathMarkValue
BreathMarkValueTick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"upbow" = BreathMarkValue -> XParse BreathMarkValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BreathMarkValue -> XParse BreathMarkValue)
-> BreathMarkValue -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ BreathMarkValue
BreathMarkValueUpbow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"salzedo" = BreathMarkValue -> XParse BreathMarkValue
forall (m :: * -> *) a. Monad m => a -> m a
return (BreathMarkValue -> XParse BreathMarkValue)
-> BreathMarkValue -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ BreathMarkValue
BreathMarkValueSalzedo
        | Bool
otherwise = String -> XParse BreathMarkValue
forall a. String -> XParse a
P.xfail (String -> XParse BreathMarkValue)
-> String -> XParse BreathMarkValue
forall a b. (a -> b) -> a -> b
$ String
"BreathMarkValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @caesura-value@ /(simple)/
--
-- The caesura-value type represents the shape of the caesura sign.
data CaesuraValue = 
      CaesuraValueNormal -- ^ /normal/
    | CaesuraValueThick -- ^ /thick/
    | CaesuraValueShort -- ^ /short/
    | CaesuraValueCurved -- ^ /curved/
    | CaesuraValueSingle -- ^ /single/
    | CaesuraValue -- ^ //
    deriving (CaesuraValue -> CaesuraValue -> Bool
(CaesuraValue -> CaesuraValue -> Bool)
-> (CaesuraValue -> CaesuraValue -> Bool) -> Eq CaesuraValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaesuraValue -> CaesuraValue -> Bool
$c/= :: CaesuraValue -> CaesuraValue -> Bool
== :: CaesuraValue -> CaesuraValue -> Bool
$c== :: CaesuraValue -> CaesuraValue -> Bool
Eq,Typeable,(forall x. CaesuraValue -> Rep CaesuraValue x)
-> (forall x. Rep CaesuraValue x -> CaesuraValue)
-> Generic CaesuraValue
forall x. Rep CaesuraValue x -> CaesuraValue
forall x. CaesuraValue -> Rep CaesuraValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CaesuraValue x -> CaesuraValue
$cfrom :: forall x. CaesuraValue -> Rep CaesuraValue x
Generic,Int -> CaesuraValue -> ShowS
[CaesuraValue] -> ShowS
CaesuraValue -> String
(Int -> CaesuraValue -> ShowS)
-> (CaesuraValue -> String)
-> ([CaesuraValue] -> ShowS)
-> Show CaesuraValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaesuraValue] -> ShowS
$cshowList :: [CaesuraValue] -> ShowS
show :: CaesuraValue -> String
$cshow :: CaesuraValue -> String
showsPrec :: Int -> CaesuraValue -> ShowS
$cshowsPrec :: Int -> CaesuraValue -> ShowS
Show,Eq CaesuraValue
Eq CaesuraValue
-> (CaesuraValue -> CaesuraValue -> Ordering)
-> (CaesuraValue -> CaesuraValue -> Bool)
-> (CaesuraValue -> CaesuraValue -> Bool)
-> (CaesuraValue -> CaesuraValue -> Bool)
-> (CaesuraValue -> CaesuraValue -> Bool)
-> (CaesuraValue -> CaesuraValue -> CaesuraValue)
-> (CaesuraValue -> CaesuraValue -> CaesuraValue)
-> Ord CaesuraValue
CaesuraValue -> CaesuraValue -> Bool
CaesuraValue -> CaesuraValue -> Ordering
CaesuraValue -> CaesuraValue -> CaesuraValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CaesuraValue -> CaesuraValue -> CaesuraValue
$cmin :: CaesuraValue -> CaesuraValue -> CaesuraValue
max :: CaesuraValue -> CaesuraValue -> CaesuraValue
$cmax :: CaesuraValue -> CaesuraValue -> CaesuraValue
>= :: CaesuraValue -> CaesuraValue -> Bool
$c>= :: CaesuraValue -> CaesuraValue -> Bool
> :: CaesuraValue -> CaesuraValue -> Bool
$c> :: CaesuraValue -> CaesuraValue -> Bool
<= :: CaesuraValue -> CaesuraValue -> Bool
$c<= :: CaesuraValue -> CaesuraValue -> Bool
< :: CaesuraValue -> CaesuraValue -> Bool
$c< :: CaesuraValue -> CaesuraValue -> Bool
compare :: CaesuraValue -> CaesuraValue -> Ordering
$ccompare :: CaesuraValue -> CaesuraValue -> Ordering
$cp1Ord :: Eq CaesuraValue
Ord,Int -> CaesuraValue
CaesuraValue -> Int
CaesuraValue -> [CaesuraValue]
CaesuraValue -> CaesuraValue
CaesuraValue -> CaesuraValue -> [CaesuraValue]
CaesuraValue -> CaesuraValue -> CaesuraValue -> [CaesuraValue]
(CaesuraValue -> CaesuraValue)
-> (CaesuraValue -> CaesuraValue)
-> (Int -> CaesuraValue)
-> (CaesuraValue -> Int)
-> (CaesuraValue -> [CaesuraValue])
-> (CaesuraValue -> CaesuraValue -> [CaesuraValue])
-> (CaesuraValue -> CaesuraValue -> [CaesuraValue])
-> (CaesuraValue -> CaesuraValue -> CaesuraValue -> [CaesuraValue])
-> Enum CaesuraValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CaesuraValue -> CaesuraValue -> CaesuraValue -> [CaesuraValue]
$cenumFromThenTo :: CaesuraValue -> CaesuraValue -> CaesuraValue -> [CaesuraValue]
enumFromTo :: CaesuraValue -> CaesuraValue -> [CaesuraValue]
$cenumFromTo :: CaesuraValue -> CaesuraValue -> [CaesuraValue]
enumFromThen :: CaesuraValue -> CaesuraValue -> [CaesuraValue]
$cenumFromThen :: CaesuraValue -> CaesuraValue -> [CaesuraValue]
enumFrom :: CaesuraValue -> [CaesuraValue]
$cenumFrom :: CaesuraValue -> [CaesuraValue]
fromEnum :: CaesuraValue -> Int
$cfromEnum :: CaesuraValue -> Int
toEnum :: Int -> CaesuraValue
$ctoEnum :: Int -> CaesuraValue
pred :: CaesuraValue -> CaesuraValue
$cpred :: CaesuraValue -> CaesuraValue
succ :: CaesuraValue -> CaesuraValue
$csucc :: CaesuraValue -> CaesuraValue
Enum,CaesuraValue
CaesuraValue -> CaesuraValue -> Bounded CaesuraValue
forall a. a -> a -> Bounded a
maxBound :: CaesuraValue
$cmaxBound :: CaesuraValue
minBound :: CaesuraValue
$cminBound :: CaesuraValue
Bounded)
instance EmitXml CaesuraValue where
    emitXml :: CaesuraValue -> XmlRep
emitXml CaesuraValue
CaesuraValueNormal = String -> XmlRep
XLit String
"normal"
    emitXml CaesuraValue
CaesuraValueThick = String -> XmlRep
XLit String
"thick"
    emitXml CaesuraValue
CaesuraValueShort = String -> XmlRep
XLit String
"short"
    emitXml CaesuraValue
CaesuraValueCurved = String -> XmlRep
XLit String
"curved"
    emitXml CaesuraValue
CaesuraValueSingle = String -> XmlRep
XLit String
"single"
    emitXml CaesuraValue
CaesuraValue = String -> XmlRep
XLit String
""
parseCaesuraValue :: String -> P.XParse CaesuraValue
parseCaesuraValue :: String -> XParse CaesuraValue
parseCaesuraValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValueNormal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"thick" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValueThick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"short" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValueShort
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"curved" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValueCurved
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValueSingle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = CaesuraValue -> XParse CaesuraValue
forall (m :: * -> *) a. Monad m => a -> m a
return (CaesuraValue -> XParse CaesuraValue)
-> CaesuraValue -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ CaesuraValue
CaesuraValue
        | Bool
otherwise = String -> XParse CaesuraValue
forall a. String -> XParse a
P.xfail (String -> XParse CaesuraValue) -> String -> XParse CaesuraValue
forall a b. (a -> b) -> a -> b
$ String
"CaesuraValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @cancel-location@ /(simple)/
--
-- The cancel-location type is used to indicate where a key signature cancellation appears relative to a new key signature: to the left, to the right, or before the barline and to the left. It is left by default. For mid-measure key elements, a cancel-location of before-barline should be treated like a cancel-location of left.
data CancelLocation = 
      CancelLocationLeft -- ^ /left/
    | CancelLocationRight -- ^ /right/
    | CancelLocationBeforeBarline -- ^ /before-barline/
    deriving (CancelLocation -> CancelLocation -> Bool
(CancelLocation -> CancelLocation -> Bool)
-> (CancelLocation -> CancelLocation -> Bool) -> Eq CancelLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelLocation -> CancelLocation -> Bool
$c/= :: CancelLocation -> CancelLocation -> Bool
== :: CancelLocation -> CancelLocation -> Bool
$c== :: CancelLocation -> CancelLocation -> Bool
Eq,Typeable,(forall x. CancelLocation -> Rep CancelLocation x)
-> (forall x. Rep CancelLocation x -> CancelLocation)
-> Generic CancelLocation
forall x. Rep CancelLocation x -> CancelLocation
forall x. CancelLocation -> Rep CancelLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelLocation x -> CancelLocation
$cfrom :: forall x. CancelLocation -> Rep CancelLocation x
Generic,Int -> CancelLocation -> ShowS
[CancelLocation] -> ShowS
CancelLocation -> String
(Int -> CancelLocation -> ShowS)
-> (CancelLocation -> String)
-> ([CancelLocation] -> ShowS)
-> Show CancelLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelLocation] -> ShowS
$cshowList :: [CancelLocation] -> ShowS
show :: CancelLocation -> String
$cshow :: CancelLocation -> String
showsPrec :: Int -> CancelLocation -> ShowS
$cshowsPrec :: Int -> CancelLocation -> ShowS
Show,Eq CancelLocation
Eq CancelLocation
-> (CancelLocation -> CancelLocation -> Ordering)
-> (CancelLocation -> CancelLocation -> Bool)
-> (CancelLocation -> CancelLocation -> Bool)
-> (CancelLocation -> CancelLocation -> Bool)
-> (CancelLocation -> CancelLocation -> Bool)
-> (CancelLocation -> CancelLocation -> CancelLocation)
-> (CancelLocation -> CancelLocation -> CancelLocation)
-> Ord CancelLocation
CancelLocation -> CancelLocation -> Bool
CancelLocation -> CancelLocation -> Ordering
CancelLocation -> CancelLocation -> CancelLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CancelLocation -> CancelLocation -> CancelLocation
$cmin :: CancelLocation -> CancelLocation -> CancelLocation
max :: CancelLocation -> CancelLocation -> CancelLocation
$cmax :: CancelLocation -> CancelLocation -> CancelLocation
>= :: CancelLocation -> CancelLocation -> Bool
$c>= :: CancelLocation -> CancelLocation -> Bool
> :: CancelLocation -> CancelLocation -> Bool
$c> :: CancelLocation -> CancelLocation -> Bool
<= :: CancelLocation -> CancelLocation -> Bool
$c<= :: CancelLocation -> CancelLocation -> Bool
< :: CancelLocation -> CancelLocation -> Bool
$c< :: CancelLocation -> CancelLocation -> Bool
compare :: CancelLocation -> CancelLocation -> Ordering
$ccompare :: CancelLocation -> CancelLocation -> Ordering
$cp1Ord :: Eq CancelLocation
Ord,Int -> CancelLocation
CancelLocation -> Int
CancelLocation -> [CancelLocation]
CancelLocation -> CancelLocation
CancelLocation -> CancelLocation -> [CancelLocation]
CancelLocation
-> CancelLocation -> CancelLocation -> [CancelLocation]
(CancelLocation -> CancelLocation)
-> (CancelLocation -> CancelLocation)
-> (Int -> CancelLocation)
-> (CancelLocation -> Int)
-> (CancelLocation -> [CancelLocation])
-> (CancelLocation -> CancelLocation -> [CancelLocation])
-> (CancelLocation -> CancelLocation -> [CancelLocation])
-> (CancelLocation
    -> CancelLocation -> CancelLocation -> [CancelLocation])
-> Enum CancelLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CancelLocation
-> CancelLocation -> CancelLocation -> [CancelLocation]
$cenumFromThenTo :: CancelLocation
-> CancelLocation -> CancelLocation -> [CancelLocation]
enumFromTo :: CancelLocation -> CancelLocation -> [CancelLocation]
$cenumFromTo :: CancelLocation -> CancelLocation -> [CancelLocation]
enumFromThen :: CancelLocation -> CancelLocation -> [CancelLocation]
$cenumFromThen :: CancelLocation -> CancelLocation -> [CancelLocation]
enumFrom :: CancelLocation -> [CancelLocation]
$cenumFrom :: CancelLocation -> [CancelLocation]
fromEnum :: CancelLocation -> Int
$cfromEnum :: CancelLocation -> Int
toEnum :: Int -> CancelLocation
$ctoEnum :: Int -> CancelLocation
pred :: CancelLocation -> CancelLocation
$cpred :: CancelLocation -> CancelLocation
succ :: CancelLocation -> CancelLocation
$csucc :: CancelLocation -> CancelLocation
Enum,CancelLocation
CancelLocation -> CancelLocation -> Bounded CancelLocation
forall a. a -> a -> Bounded a
maxBound :: CancelLocation
$cmaxBound :: CancelLocation
minBound :: CancelLocation
$cminBound :: CancelLocation
Bounded)
instance EmitXml CancelLocation where
    emitXml :: CancelLocation -> XmlRep
emitXml CancelLocation
CancelLocationLeft = String -> XmlRep
XLit String
"left"
    emitXml CancelLocation
CancelLocationRight = String -> XmlRep
XLit String
"right"
    emitXml CancelLocation
CancelLocationBeforeBarline = String -> XmlRep
XLit String
"before-barline"
parseCancelLocation :: String -> P.XParse CancelLocation
parseCancelLocation :: String -> XParse CancelLocation
parseCancelLocation String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = CancelLocation -> XParse CancelLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (CancelLocation -> XParse CancelLocation)
-> CancelLocation -> XParse CancelLocation
forall a b. (a -> b) -> a -> b
$ CancelLocation
CancelLocationLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = CancelLocation -> XParse CancelLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (CancelLocation -> XParse CancelLocation)
-> CancelLocation -> XParse CancelLocation
forall a b. (a -> b) -> a -> b
$ CancelLocation
CancelLocationRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"before-barline" = CancelLocation -> XParse CancelLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (CancelLocation -> XParse CancelLocation)
-> CancelLocation -> XParse CancelLocation
forall a b. (a -> b) -> a -> b
$ CancelLocation
CancelLocationBeforeBarline
        | Bool
otherwise = String -> XParse CancelLocation
forall a. String -> XParse a
P.xfail (String -> XParse CancelLocation)
-> String -> XParse CancelLocation
forall a b. (a -> b) -> a -> b
$ String
"CancelLocation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @circular-arrow@ /(simple)/
--
-- The circular-arrow type represents the direction in which a circular arrow points, using Unicode arrow terminology.
data CircularArrow = 
      CircularArrowClockwise -- ^ /clockwise/
    | CircularArrowAnticlockwise -- ^ /anticlockwise/
    deriving (CircularArrow -> CircularArrow -> Bool
(CircularArrow -> CircularArrow -> Bool)
-> (CircularArrow -> CircularArrow -> Bool) -> Eq CircularArrow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CircularArrow -> CircularArrow -> Bool
$c/= :: CircularArrow -> CircularArrow -> Bool
== :: CircularArrow -> CircularArrow -> Bool
$c== :: CircularArrow -> CircularArrow -> Bool
Eq,Typeable,(forall x. CircularArrow -> Rep CircularArrow x)
-> (forall x. Rep CircularArrow x -> CircularArrow)
-> Generic CircularArrow
forall x. Rep CircularArrow x -> CircularArrow
forall x. CircularArrow -> Rep CircularArrow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CircularArrow x -> CircularArrow
$cfrom :: forall x. CircularArrow -> Rep CircularArrow x
Generic,Int -> CircularArrow -> ShowS
[CircularArrow] -> ShowS
CircularArrow -> String
(Int -> CircularArrow -> ShowS)
-> (CircularArrow -> String)
-> ([CircularArrow] -> ShowS)
-> Show CircularArrow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CircularArrow] -> ShowS
$cshowList :: [CircularArrow] -> ShowS
show :: CircularArrow -> String
$cshow :: CircularArrow -> String
showsPrec :: Int -> CircularArrow -> ShowS
$cshowsPrec :: Int -> CircularArrow -> ShowS
Show,Eq CircularArrow
Eq CircularArrow
-> (CircularArrow -> CircularArrow -> Ordering)
-> (CircularArrow -> CircularArrow -> Bool)
-> (CircularArrow -> CircularArrow -> Bool)
-> (CircularArrow -> CircularArrow -> Bool)
-> (CircularArrow -> CircularArrow -> Bool)
-> (CircularArrow -> CircularArrow -> CircularArrow)
-> (CircularArrow -> CircularArrow -> CircularArrow)
-> Ord CircularArrow
CircularArrow -> CircularArrow -> Bool
CircularArrow -> CircularArrow -> Ordering
CircularArrow -> CircularArrow -> CircularArrow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CircularArrow -> CircularArrow -> CircularArrow
$cmin :: CircularArrow -> CircularArrow -> CircularArrow
max :: CircularArrow -> CircularArrow -> CircularArrow
$cmax :: CircularArrow -> CircularArrow -> CircularArrow
>= :: CircularArrow -> CircularArrow -> Bool
$c>= :: CircularArrow -> CircularArrow -> Bool
> :: CircularArrow -> CircularArrow -> Bool
$c> :: CircularArrow -> CircularArrow -> Bool
<= :: CircularArrow -> CircularArrow -> Bool
$c<= :: CircularArrow -> CircularArrow -> Bool
< :: CircularArrow -> CircularArrow -> Bool
$c< :: CircularArrow -> CircularArrow -> Bool
compare :: CircularArrow -> CircularArrow -> Ordering
$ccompare :: CircularArrow -> CircularArrow -> Ordering
$cp1Ord :: Eq CircularArrow
Ord,Int -> CircularArrow
CircularArrow -> Int
CircularArrow -> [CircularArrow]
CircularArrow -> CircularArrow
CircularArrow -> CircularArrow -> [CircularArrow]
CircularArrow -> CircularArrow -> CircularArrow -> [CircularArrow]
(CircularArrow -> CircularArrow)
-> (CircularArrow -> CircularArrow)
-> (Int -> CircularArrow)
-> (CircularArrow -> Int)
-> (CircularArrow -> [CircularArrow])
-> (CircularArrow -> CircularArrow -> [CircularArrow])
-> (CircularArrow -> CircularArrow -> [CircularArrow])
-> (CircularArrow
    -> CircularArrow -> CircularArrow -> [CircularArrow])
-> Enum CircularArrow
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CircularArrow -> CircularArrow -> CircularArrow -> [CircularArrow]
$cenumFromThenTo :: CircularArrow -> CircularArrow -> CircularArrow -> [CircularArrow]
enumFromTo :: CircularArrow -> CircularArrow -> [CircularArrow]
$cenumFromTo :: CircularArrow -> CircularArrow -> [CircularArrow]
enumFromThen :: CircularArrow -> CircularArrow -> [CircularArrow]
$cenumFromThen :: CircularArrow -> CircularArrow -> [CircularArrow]
enumFrom :: CircularArrow -> [CircularArrow]
$cenumFrom :: CircularArrow -> [CircularArrow]
fromEnum :: CircularArrow -> Int
$cfromEnum :: CircularArrow -> Int
toEnum :: Int -> CircularArrow
$ctoEnum :: Int -> CircularArrow
pred :: CircularArrow -> CircularArrow
$cpred :: CircularArrow -> CircularArrow
succ :: CircularArrow -> CircularArrow
$csucc :: CircularArrow -> CircularArrow
Enum,CircularArrow
CircularArrow -> CircularArrow -> Bounded CircularArrow
forall a. a -> a -> Bounded a
maxBound :: CircularArrow
$cmaxBound :: CircularArrow
minBound :: CircularArrow
$cminBound :: CircularArrow
Bounded)
instance EmitXml CircularArrow where
    emitXml :: CircularArrow -> XmlRep
emitXml CircularArrow
CircularArrowClockwise = String -> XmlRep
XLit String
"clockwise"
    emitXml CircularArrow
CircularArrowAnticlockwise = String -> XmlRep
XLit String
"anticlockwise"
parseCircularArrow :: String -> P.XParse CircularArrow
parseCircularArrow :: String -> XParse CircularArrow
parseCircularArrow String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"clockwise" = CircularArrow -> XParse CircularArrow
forall (m :: * -> *) a. Monad m => a -> m a
return (CircularArrow -> XParse CircularArrow)
-> CircularArrow -> XParse CircularArrow
forall a b. (a -> b) -> a -> b
$ CircularArrow
CircularArrowClockwise
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"anticlockwise" = CircularArrow -> XParse CircularArrow
forall (m :: * -> *) a. Monad m => a -> m a
return (CircularArrow -> XParse CircularArrow)
-> CircularArrow -> XParse CircularArrow
forall a b. (a -> b) -> a -> b
$ CircularArrow
CircularArrowAnticlockwise
        | Bool
otherwise = String -> XParse CircularArrow
forall a. String -> XParse a
P.xfail (String -> XParse CircularArrow) -> String -> XParse CircularArrow
forall a b. (a -> b) -> a -> b
$ String
"CircularArrow: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @clef-sign@ /(simple)/
--
-- The clef-sign element represents the different clef symbols. The jianpu sign indicates that the music that follows should be in jianpu numbered notation, just as the TAB sign indicates that the music that follows should be in tablature notation. Unlike TAB, a jianpu sign does not correspond to a visual clef notation.
data ClefSign = 
      ClefSignG -- ^ /G/
    | ClefSignF -- ^ /F/
    | ClefSignC -- ^ /C/
    | ClefSignPercussion -- ^ /percussion/
    | ClefSignTAB -- ^ /TAB/
    | ClefSignJianpu -- ^ /jianpu/
    | ClefSignNone -- ^ /none/
    deriving (ClefSign -> ClefSign -> Bool
(ClefSign -> ClefSign -> Bool)
-> (ClefSign -> ClefSign -> Bool) -> Eq ClefSign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClefSign -> ClefSign -> Bool
$c/= :: ClefSign -> ClefSign -> Bool
== :: ClefSign -> ClefSign -> Bool
$c== :: ClefSign -> ClefSign -> Bool
Eq,Typeable,(forall x. ClefSign -> Rep ClefSign x)
-> (forall x. Rep ClefSign x -> ClefSign) -> Generic ClefSign
forall x. Rep ClefSign x -> ClefSign
forall x. ClefSign -> Rep ClefSign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClefSign x -> ClefSign
$cfrom :: forall x. ClefSign -> Rep ClefSign x
Generic,Int -> ClefSign -> ShowS
[ClefSign] -> ShowS
ClefSign -> String
(Int -> ClefSign -> ShowS)
-> (ClefSign -> String) -> ([ClefSign] -> ShowS) -> Show ClefSign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClefSign] -> ShowS
$cshowList :: [ClefSign] -> ShowS
show :: ClefSign -> String
$cshow :: ClefSign -> String
showsPrec :: Int -> ClefSign -> ShowS
$cshowsPrec :: Int -> ClefSign -> ShowS
Show,Eq ClefSign
Eq ClefSign
-> (ClefSign -> ClefSign -> Ordering)
-> (ClefSign -> ClefSign -> Bool)
-> (ClefSign -> ClefSign -> Bool)
-> (ClefSign -> ClefSign -> Bool)
-> (ClefSign -> ClefSign -> Bool)
-> (ClefSign -> ClefSign -> ClefSign)
-> (ClefSign -> ClefSign -> ClefSign)
-> Ord ClefSign
ClefSign -> ClefSign -> Bool
ClefSign -> ClefSign -> Ordering
ClefSign -> ClefSign -> ClefSign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClefSign -> ClefSign -> ClefSign
$cmin :: ClefSign -> ClefSign -> ClefSign
max :: ClefSign -> ClefSign -> ClefSign
$cmax :: ClefSign -> ClefSign -> ClefSign
>= :: ClefSign -> ClefSign -> Bool
$c>= :: ClefSign -> ClefSign -> Bool
> :: ClefSign -> ClefSign -> Bool
$c> :: ClefSign -> ClefSign -> Bool
<= :: ClefSign -> ClefSign -> Bool
$c<= :: ClefSign -> ClefSign -> Bool
< :: ClefSign -> ClefSign -> Bool
$c< :: ClefSign -> ClefSign -> Bool
compare :: ClefSign -> ClefSign -> Ordering
$ccompare :: ClefSign -> ClefSign -> Ordering
$cp1Ord :: Eq ClefSign
Ord,Int -> ClefSign
ClefSign -> Int
ClefSign -> [ClefSign]
ClefSign -> ClefSign
ClefSign -> ClefSign -> [ClefSign]
ClefSign -> ClefSign -> ClefSign -> [ClefSign]
(ClefSign -> ClefSign)
-> (ClefSign -> ClefSign)
-> (Int -> ClefSign)
-> (ClefSign -> Int)
-> (ClefSign -> [ClefSign])
-> (ClefSign -> ClefSign -> [ClefSign])
-> (ClefSign -> ClefSign -> [ClefSign])
-> (ClefSign -> ClefSign -> ClefSign -> [ClefSign])
-> Enum ClefSign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ClefSign -> ClefSign -> ClefSign -> [ClefSign]
$cenumFromThenTo :: ClefSign -> ClefSign -> ClefSign -> [ClefSign]
enumFromTo :: ClefSign -> ClefSign -> [ClefSign]
$cenumFromTo :: ClefSign -> ClefSign -> [ClefSign]
enumFromThen :: ClefSign -> ClefSign -> [ClefSign]
$cenumFromThen :: ClefSign -> ClefSign -> [ClefSign]
enumFrom :: ClefSign -> [ClefSign]
$cenumFrom :: ClefSign -> [ClefSign]
fromEnum :: ClefSign -> Int
$cfromEnum :: ClefSign -> Int
toEnum :: Int -> ClefSign
$ctoEnum :: Int -> ClefSign
pred :: ClefSign -> ClefSign
$cpred :: ClefSign -> ClefSign
succ :: ClefSign -> ClefSign
$csucc :: ClefSign -> ClefSign
Enum,ClefSign
ClefSign -> ClefSign -> Bounded ClefSign
forall a. a -> a -> Bounded a
maxBound :: ClefSign
$cmaxBound :: ClefSign
minBound :: ClefSign
$cminBound :: ClefSign
Bounded)
instance EmitXml ClefSign where
    emitXml :: ClefSign -> XmlRep
emitXml ClefSign
ClefSignG = String -> XmlRep
XLit String
"G"
    emitXml ClefSign
ClefSignF = String -> XmlRep
XLit String
"F"
    emitXml ClefSign
ClefSignC = String -> XmlRep
XLit String
"C"
    emitXml ClefSign
ClefSignPercussion = String -> XmlRep
XLit String
"percussion"
    emitXml ClefSign
ClefSignTAB = String -> XmlRep
XLit String
"TAB"
    emitXml ClefSign
ClefSignJianpu = String -> XmlRep
XLit String
"jianpu"
    emitXml ClefSign
ClefSignNone = String -> XmlRep
XLit String
"none"
parseClefSign :: String -> P.XParse ClefSign
parseClefSign :: String -> XParse ClefSign
parseClefSign String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"G" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignG
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"F" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignF
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"C" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignC
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"percussion" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignPercussion
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TAB" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignTAB
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"jianpu" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignJianpu
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = ClefSign -> XParse ClefSign
forall (m :: * -> *) a. Monad m => a -> m a
return (ClefSign -> XParse ClefSign) -> ClefSign -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ ClefSign
ClefSignNone
        | Bool
otherwise = String -> XParse ClefSign
forall a. String -> XParse a
P.xfail (String -> XParse ClefSign) -> String -> XParse ClefSign
forall a b. (a -> b) -> a -> b
$ String
"ClefSign: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @color@ /(simple)/
--
-- The color type indicates the color of an element. Color may be represented as hexadecimal RGB triples, as in HTML, or as hexadecimal ARGB tuples, with the A indicating alpha of transparency. An alpha value of 00 is totally transparent; FF is totally opaque. If RGB is used, the A value is assumed to be FF.
-- 
-- For instance, the RGB value "#800080" represents purple. An ARGB value of "#40800080" would be a transparent purple.
-- 
-- As in SVG 1.1, colors are defined in terms of the sRGB color space (IEC 61966).
newtype Color = Color { Color -> Token
color :: Token }
    deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq,Typeable,(forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic,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
min :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
$cp1Ord :: Eq Color
Ord,String -> Color
(String -> Color) -> IsString Color
forall a. (String -> a) -> IsString a
fromString :: String -> Color
$cfromString :: String -> Color
IsString)
instance Show Color where show :: Color -> String
show (Color Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read Color where readsPrec :: Int -> ReadS Color
readsPrec Int
i = ((Token, String) -> (Color, String))
-> [(Token, String)] -> [(Color, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> Color) -> (Token, String) -> (Color, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> Color
Color) ([(Token, String)] -> [(Color, String)])
-> (String -> [(Token, String)]) -> ReadS Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Color where
    emitXml :: Color -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (Color -> Token) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Token
color
parseColor :: String -> P.XParse Color
parseColor :: String -> XParse Color
parseColor = Color -> XParse Color
forall (m :: * -> *) a. Monad m => a -> m a
return (Color -> XParse Color)
-> (String -> Color) -> String -> XParse Color
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Color
forall a. IsString a => String -> a
fromString

-- | @comma-separated-text@ /(simple)/
--
-- The comma-separated-text type is used to specify a comma-separated list of text elements, as is used by the font-family attribute.
newtype CommaSeparatedText = CommaSeparatedText { CommaSeparatedText -> Token
commaSeparatedText :: Token }
    deriving (CommaSeparatedText -> CommaSeparatedText -> Bool
(CommaSeparatedText -> CommaSeparatedText -> Bool)
-> (CommaSeparatedText -> CommaSeparatedText -> Bool)
-> Eq CommaSeparatedText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c/= :: CommaSeparatedText -> CommaSeparatedText -> Bool
== :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c== :: CommaSeparatedText -> CommaSeparatedText -> Bool
Eq,Typeable,(forall x. CommaSeparatedText -> Rep CommaSeparatedText x)
-> (forall x. Rep CommaSeparatedText x -> CommaSeparatedText)
-> Generic CommaSeparatedText
forall x. Rep CommaSeparatedText x -> CommaSeparatedText
forall x. CommaSeparatedText -> Rep CommaSeparatedText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CommaSeparatedText x -> CommaSeparatedText
$cfrom :: forall x. CommaSeparatedText -> Rep CommaSeparatedText x
Generic,Eq CommaSeparatedText
Eq CommaSeparatedText
-> (CommaSeparatedText -> CommaSeparatedText -> Ordering)
-> (CommaSeparatedText -> CommaSeparatedText -> Bool)
-> (CommaSeparatedText -> CommaSeparatedText -> Bool)
-> (CommaSeparatedText -> CommaSeparatedText -> Bool)
-> (CommaSeparatedText -> CommaSeparatedText -> Bool)
-> (CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText)
-> (CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText)
-> Ord CommaSeparatedText
CommaSeparatedText -> CommaSeparatedText -> Bool
CommaSeparatedText -> CommaSeparatedText -> Ordering
CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText
$cmin :: CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText
max :: CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText
$cmax :: CommaSeparatedText -> CommaSeparatedText -> CommaSeparatedText
>= :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c>= :: CommaSeparatedText -> CommaSeparatedText -> Bool
> :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c> :: CommaSeparatedText -> CommaSeparatedText -> Bool
<= :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c<= :: CommaSeparatedText -> CommaSeparatedText -> Bool
< :: CommaSeparatedText -> CommaSeparatedText -> Bool
$c< :: CommaSeparatedText -> CommaSeparatedText -> Bool
compare :: CommaSeparatedText -> CommaSeparatedText -> Ordering
$ccompare :: CommaSeparatedText -> CommaSeparatedText -> Ordering
$cp1Ord :: Eq CommaSeparatedText
Ord,String -> CommaSeparatedText
(String -> CommaSeparatedText) -> IsString CommaSeparatedText
forall a. (String -> a) -> IsString a
fromString :: String -> CommaSeparatedText
$cfromString :: String -> CommaSeparatedText
IsString)
instance Show CommaSeparatedText where show :: CommaSeparatedText -> String
show (CommaSeparatedText Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read CommaSeparatedText where readsPrec :: Int -> ReadS CommaSeparatedText
readsPrec Int
i = ((Token, String) -> (CommaSeparatedText, String))
-> [(Token, String)] -> [(CommaSeparatedText, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> CommaSeparatedText)
-> (Token, String) -> (CommaSeparatedText, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> CommaSeparatedText
CommaSeparatedText) ([(Token, String)] -> [(CommaSeparatedText, String)])
-> (String -> [(Token, String)]) -> ReadS CommaSeparatedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml CommaSeparatedText where
    emitXml :: CommaSeparatedText -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep)
-> (CommaSeparatedText -> Token) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommaSeparatedText -> Token
commaSeparatedText
parseCommaSeparatedText :: String -> P.XParse CommaSeparatedText
parseCommaSeparatedText :: String -> XParse CommaSeparatedText
parseCommaSeparatedText = CommaSeparatedText -> XParse CommaSeparatedText
forall (m :: * -> *) a. Monad m => a -> m a
return (CommaSeparatedText -> XParse CommaSeparatedText)
-> (String -> CommaSeparatedText)
-> String
-> XParse CommaSeparatedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CommaSeparatedText
forall a. IsString a => String -> a
fromString

-- | @css-font-size@ /(simple)/
--
-- The css-font-size type includes the CSS font sizes used as an alternative to a numeric point size.
data CssFontSize = 
      CssFontSizeXxSmall -- ^ /xx-small/
    | CssFontSizeXSmall -- ^ /x-small/
    | CssFontSizeSmall -- ^ /small/
    | CssFontSizeMedium -- ^ /medium/
    | CssFontSizeLarge -- ^ /large/
    | CssFontSizeXLarge -- ^ /x-large/
    | CssFontSizeXxLarge -- ^ /xx-large/
    deriving (CssFontSize -> CssFontSize -> Bool
(CssFontSize -> CssFontSize -> Bool)
-> (CssFontSize -> CssFontSize -> Bool) -> Eq CssFontSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CssFontSize -> CssFontSize -> Bool
$c/= :: CssFontSize -> CssFontSize -> Bool
== :: CssFontSize -> CssFontSize -> Bool
$c== :: CssFontSize -> CssFontSize -> Bool
Eq,Typeable,(forall x. CssFontSize -> Rep CssFontSize x)
-> (forall x. Rep CssFontSize x -> CssFontSize)
-> Generic CssFontSize
forall x. Rep CssFontSize x -> CssFontSize
forall x. CssFontSize -> Rep CssFontSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CssFontSize x -> CssFontSize
$cfrom :: forall x. CssFontSize -> Rep CssFontSize x
Generic,Int -> CssFontSize -> ShowS
[CssFontSize] -> ShowS
CssFontSize -> String
(Int -> CssFontSize -> ShowS)
-> (CssFontSize -> String)
-> ([CssFontSize] -> ShowS)
-> Show CssFontSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CssFontSize] -> ShowS
$cshowList :: [CssFontSize] -> ShowS
show :: CssFontSize -> String
$cshow :: CssFontSize -> String
showsPrec :: Int -> CssFontSize -> ShowS
$cshowsPrec :: Int -> CssFontSize -> ShowS
Show,Eq CssFontSize
Eq CssFontSize
-> (CssFontSize -> CssFontSize -> Ordering)
-> (CssFontSize -> CssFontSize -> Bool)
-> (CssFontSize -> CssFontSize -> Bool)
-> (CssFontSize -> CssFontSize -> Bool)
-> (CssFontSize -> CssFontSize -> Bool)
-> (CssFontSize -> CssFontSize -> CssFontSize)
-> (CssFontSize -> CssFontSize -> CssFontSize)
-> Ord CssFontSize
CssFontSize -> CssFontSize -> Bool
CssFontSize -> CssFontSize -> Ordering
CssFontSize -> CssFontSize -> CssFontSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CssFontSize -> CssFontSize -> CssFontSize
$cmin :: CssFontSize -> CssFontSize -> CssFontSize
max :: CssFontSize -> CssFontSize -> CssFontSize
$cmax :: CssFontSize -> CssFontSize -> CssFontSize
>= :: CssFontSize -> CssFontSize -> Bool
$c>= :: CssFontSize -> CssFontSize -> Bool
> :: CssFontSize -> CssFontSize -> Bool
$c> :: CssFontSize -> CssFontSize -> Bool
<= :: CssFontSize -> CssFontSize -> Bool
$c<= :: CssFontSize -> CssFontSize -> Bool
< :: CssFontSize -> CssFontSize -> Bool
$c< :: CssFontSize -> CssFontSize -> Bool
compare :: CssFontSize -> CssFontSize -> Ordering
$ccompare :: CssFontSize -> CssFontSize -> Ordering
$cp1Ord :: Eq CssFontSize
Ord,Int -> CssFontSize
CssFontSize -> Int
CssFontSize -> [CssFontSize]
CssFontSize -> CssFontSize
CssFontSize -> CssFontSize -> [CssFontSize]
CssFontSize -> CssFontSize -> CssFontSize -> [CssFontSize]
(CssFontSize -> CssFontSize)
-> (CssFontSize -> CssFontSize)
-> (Int -> CssFontSize)
-> (CssFontSize -> Int)
-> (CssFontSize -> [CssFontSize])
-> (CssFontSize -> CssFontSize -> [CssFontSize])
-> (CssFontSize -> CssFontSize -> [CssFontSize])
-> (CssFontSize -> CssFontSize -> CssFontSize -> [CssFontSize])
-> Enum CssFontSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CssFontSize -> CssFontSize -> CssFontSize -> [CssFontSize]
$cenumFromThenTo :: CssFontSize -> CssFontSize -> CssFontSize -> [CssFontSize]
enumFromTo :: CssFontSize -> CssFontSize -> [CssFontSize]
$cenumFromTo :: CssFontSize -> CssFontSize -> [CssFontSize]
enumFromThen :: CssFontSize -> CssFontSize -> [CssFontSize]
$cenumFromThen :: CssFontSize -> CssFontSize -> [CssFontSize]
enumFrom :: CssFontSize -> [CssFontSize]
$cenumFrom :: CssFontSize -> [CssFontSize]
fromEnum :: CssFontSize -> Int
$cfromEnum :: CssFontSize -> Int
toEnum :: Int -> CssFontSize
$ctoEnum :: Int -> CssFontSize
pred :: CssFontSize -> CssFontSize
$cpred :: CssFontSize -> CssFontSize
succ :: CssFontSize -> CssFontSize
$csucc :: CssFontSize -> CssFontSize
Enum,CssFontSize
CssFontSize -> CssFontSize -> Bounded CssFontSize
forall a. a -> a -> Bounded a
maxBound :: CssFontSize
$cmaxBound :: CssFontSize
minBound :: CssFontSize
$cminBound :: CssFontSize
Bounded)
instance EmitXml CssFontSize where
    emitXml :: CssFontSize -> XmlRep
emitXml CssFontSize
CssFontSizeXxSmall = String -> XmlRep
XLit String
"xx-small"
    emitXml CssFontSize
CssFontSizeXSmall = String -> XmlRep
XLit String
"x-small"
    emitXml CssFontSize
CssFontSizeSmall = String -> XmlRep
XLit String
"small"
    emitXml CssFontSize
CssFontSizeMedium = String -> XmlRep
XLit String
"medium"
    emitXml CssFontSize
CssFontSizeLarge = String -> XmlRep
XLit String
"large"
    emitXml CssFontSize
CssFontSizeXLarge = String -> XmlRep
XLit String
"x-large"
    emitXml CssFontSize
CssFontSizeXxLarge = String -> XmlRep
XLit String
"xx-large"
parseCssFontSize :: String -> P.XParse CssFontSize
parseCssFontSize :: String -> XParse CssFontSize
parseCssFontSize String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xx-small" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeXxSmall
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x-small" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeXSmall
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"small" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeSmall
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeMedium
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"large" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeLarge
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x-large" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeXLarge
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xx-large" = CssFontSize -> XParse CssFontSize
forall (m :: * -> *) a. Monad m => a -> m a
return (CssFontSize -> XParse CssFontSize)
-> CssFontSize -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ CssFontSize
CssFontSizeXxLarge
        | Bool
otherwise = String -> XParse CssFontSize
forall a. String -> XParse a
P.xfail (String -> XParse CssFontSize) -> String -> XParse CssFontSize
forall a b. (a -> b) -> a -> b
$ String
"CssFontSize: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @degree-symbol-value@ /(simple)/
--
-- The degree-symbol-value type indicates indicates that a symbol should be used in specifying the degree.
data DegreeSymbolValue = 
      DegreeSymbolValueMajor -- ^ /major/
    | DegreeSymbolValueMinor -- ^ /minor/
    | DegreeSymbolValueAugmented -- ^ /augmented/
    | DegreeSymbolValueDiminished -- ^ /diminished/
    | DegreeSymbolValueHalfDiminished -- ^ /half-diminished/
    deriving (DegreeSymbolValue -> DegreeSymbolValue -> Bool
(DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> (DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> Eq DegreeSymbolValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c/= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
== :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c== :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
Eq,Typeable,(forall x. DegreeSymbolValue -> Rep DegreeSymbolValue x)
-> (forall x. Rep DegreeSymbolValue x -> DegreeSymbolValue)
-> Generic DegreeSymbolValue
forall x. Rep DegreeSymbolValue x -> DegreeSymbolValue
forall x. DegreeSymbolValue -> Rep DegreeSymbolValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DegreeSymbolValue x -> DegreeSymbolValue
$cfrom :: forall x. DegreeSymbolValue -> Rep DegreeSymbolValue x
Generic,Int -> DegreeSymbolValue -> ShowS
[DegreeSymbolValue] -> ShowS
DegreeSymbolValue -> String
(Int -> DegreeSymbolValue -> ShowS)
-> (DegreeSymbolValue -> String)
-> ([DegreeSymbolValue] -> ShowS)
-> Show DegreeSymbolValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DegreeSymbolValue] -> ShowS
$cshowList :: [DegreeSymbolValue] -> ShowS
show :: DegreeSymbolValue -> String
$cshow :: DegreeSymbolValue -> String
showsPrec :: Int -> DegreeSymbolValue -> ShowS
$cshowsPrec :: Int -> DegreeSymbolValue -> ShowS
Show,Eq DegreeSymbolValue
Eq DegreeSymbolValue
-> (DegreeSymbolValue -> DegreeSymbolValue -> Ordering)
-> (DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> (DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> (DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> (DegreeSymbolValue -> DegreeSymbolValue -> Bool)
-> (DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue)
-> (DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue)
-> Ord DegreeSymbolValue
DegreeSymbolValue -> DegreeSymbolValue -> Bool
DegreeSymbolValue -> DegreeSymbolValue -> Ordering
DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue
$cmin :: DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue
max :: DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue
$cmax :: DegreeSymbolValue -> DegreeSymbolValue -> DegreeSymbolValue
>= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c>= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
> :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c> :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
<= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c<= :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
< :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
$c< :: DegreeSymbolValue -> DegreeSymbolValue -> Bool
compare :: DegreeSymbolValue -> DegreeSymbolValue -> Ordering
$ccompare :: DegreeSymbolValue -> DegreeSymbolValue -> Ordering
$cp1Ord :: Eq DegreeSymbolValue
Ord,Int -> DegreeSymbolValue
DegreeSymbolValue -> Int
DegreeSymbolValue -> [DegreeSymbolValue]
DegreeSymbolValue -> DegreeSymbolValue
DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
DegreeSymbolValue
-> DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
(DegreeSymbolValue -> DegreeSymbolValue)
-> (DegreeSymbolValue -> DegreeSymbolValue)
-> (Int -> DegreeSymbolValue)
-> (DegreeSymbolValue -> Int)
-> (DegreeSymbolValue -> [DegreeSymbolValue])
-> (DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue])
-> (DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue])
-> (DegreeSymbolValue
    -> DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue])
-> Enum DegreeSymbolValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DegreeSymbolValue
-> DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
$cenumFromThenTo :: DegreeSymbolValue
-> DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
enumFromTo :: DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
$cenumFromTo :: DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
enumFromThen :: DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
$cenumFromThen :: DegreeSymbolValue -> DegreeSymbolValue -> [DegreeSymbolValue]
enumFrom :: DegreeSymbolValue -> [DegreeSymbolValue]
$cenumFrom :: DegreeSymbolValue -> [DegreeSymbolValue]
fromEnum :: DegreeSymbolValue -> Int
$cfromEnum :: DegreeSymbolValue -> Int
toEnum :: Int -> DegreeSymbolValue
$ctoEnum :: Int -> DegreeSymbolValue
pred :: DegreeSymbolValue -> DegreeSymbolValue
$cpred :: DegreeSymbolValue -> DegreeSymbolValue
succ :: DegreeSymbolValue -> DegreeSymbolValue
$csucc :: DegreeSymbolValue -> DegreeSymbolValue
Enum,DegreeSymbolValue
DegreeSymbolValue -> DegreeSymbolValue -> Bounded DegreeSymbolValue
forall a. a -> a -> Bounded a
maxBound :: DegreeSymbolValue
$cmaxBound :: DegreeSymbolValue
minBound :: DegreeSymbolValue
$cminBound :: DegreeSymbolValue
Bounded)
instance EmitXml DegreeSymbolValue where
    emitXml :: DegreeSymbolValue -> XmlRep
emitXml DegreeSymbolValue
DegreeSymbolValueMajor = String -> XmlRep
XLit String
"major"
    emitXml DegreeSymbolValue
DegreeSymbolValueMinor = String -> XmlRep
XLit String
"minor"
    emitXml DegreeSymbolValue
DegreeSymbolValueAugmented = String -> XmlRep
XLit String
"augmented"
    emitXml DegreeSymbolValue
DegreeSymbolValueDiminished = String -> XmlRep
XLit String
"diminished"
    emitXml DegreeSymbolValue
DegreeSymbolValueHalfDiminished = String -> XmlRep
XLit String
"half-diminished"
parseDegreeSymbolValue :: String -> P.XParse DegreeSymbolValue
parseDegreeSymbolValue :: String -> XParse DegreeSymbolValue
parseDegreeSymbolValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major" = DegreeSymbolValue -> XParse DegreeSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeSymbolValue -> XParse DegreeSymbolValue)
-> DegreeSymbolValue -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ DegreeSymbolValue
DegreeSymbolValueMajor
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor" = DegreeSymbolValue -> XParse DegreeSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeSymbolValue -> XParse DegreeSymbolValue)
-> DegreeSymbolValue -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ DegreeSymbolValue
DegreeSymbolValueMinor
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"augmented" = DegreeSymbolValue -> XParse DegreeSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeSymbolValue -> XParse DegreeSymbolValue)
-> DegreeSymbolValue -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ DegreeSymbolValue
DegreeSymbolValueAugmented
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diminished" = DegreeSymbolValue -> XParse DegreeSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeSymbolValue -> XParse DegreeSymbolValue)
-> DegreeSymbolValue -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ DegreeSymbolValue
DegreeSymbolValueDiminished
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half-diminished" = DegreeSymbolValue -> XParse DegreeSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeSymbolValue -> XParse DegreeSymbolValue)
-> DegreeSymbolValue -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ DegreeSymbolValue
DegreeSymbolValueHalfDiminished
        | Bool
otherwise = String -> XParse DegreeSymbolValue
forall a. String -> XParse a
P.xfail (String -> XParse DegreeSymbolValue)
-> String -> XParse DegreeSymbolValue
forall a b. (a -> b) -> a -> b
$ String
"DegreeSymbolValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @degree-type-value@ /(simple)/
--
-- The degree-type-value type indicates whether the current degree element is an addition, alteration, or subtraction to the kind of the current chord in the harmony element.
data DegreeTypeValue = 
      DegreeTypeValueAdd -- ^ /add/
    | DegreeTypeValueAlter -- ^ /alter/
    | DegreeTypeValueSubtract -- ^ /subtract/
    deriving (DegreeTypeValue -> DegreeTypeValue -> Bool
(DegreeTypeValue -> DegreeTypeValue -> Bool)
-> (DegreeTypeValue -> DegreeTypeValue -> Bool)
-> Eq DegreeTypeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c/= :: DegreeTypeValue -> DegreeTypeValue -> Bool
== :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c== :: DegreeTypeValue -> DegreeTypeValue -> Bool
Eq,Typeable,(forall x. DegreeTypeValue -> Rep DegreeTypeValue x)
-> (forall x. Rep DegreeTypeValue x -> DegreeTypeValue)
-> Generic DegreeTypeValue
forall x. Rep DegreeTypeValue x -> DegreeTypeValue
forall x. DegreeTypeValue -> Rep DegreeTypeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DegreeTypeValue x -> DegreeTypeValue
$cfrom :: forall x. DegreeTypeValue -> Rep DegreeTypeValue x
Generic,Int -> DegreeTypeValue -> ShowS
[DegreeTypeValue] -> ShowS
DegreeTypeValue -> String
(Int -> DegreeTypeValue -> ShowS)
-> (DegreeTypeValue -> String)
-> ([DegreeTypeValue] -> ShowS)
-> Show DegreeTypeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DegreeTypeValue] -> ShowS
$cshowList :: [DegreeTypeValue] -> ShowS
show :: DegreeTypeValue -> String
$cshow :: DegreeTypeValue -> String
showsPrec :: Int -> DegreeTypeValue -> ShowS
$cshowsPrec :: Int -> DegreeTypeValue -> ShowS
Show,Eq DegreeTypeValue
Eq DegreeTypeValue
-> (DegreeTypeValue -> DegreeTypeValue -> Ordering)
-> (DegreeTypeValue -> DegreeTypeValue -> Bool)
-> (DegreeTypeValue -> DegreeTypeValue -> Bool)
-> (DegreeTypeValue -> DegreeTypeValue -> Bool)
-> (DegreeTypeValue -> DegreeTypeValue -> Bool)
-> (DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue)
-> (DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue)
-> Ord DegreeTypeValue
DegreeTypeValue -> DegreeTypeValue -> Bool
DegreeTypeValue -> DegreeTypeValue -> Ordering
DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue
$cmin :: DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue
max :: DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue
$cmax :: DegreeTypeValue -> DegreeTypeValue -> DegreeTypeValue
>= :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c>= :: DegreeTypeValue -> DegreeTypeValue -> Bool
> :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c> :: DegreeTypeValue -> DegreeTypeValue -> Bool
<= :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c<= :: DegreeTypeValue -> DegreeTypeValue -> Bool
< :: DegreeTypeValue -> DegreeTypeValue -> Bool
$c< :: DegreeTypeValue -> DegreeTypeValue -> Bool
compare :: DegreeTypeValue -> DegreeTypeValue -> Ordering
$ccompare :: DegreeTypeValue -> DegreeTypeValue -> Ordering
$cp1Ord :: Eq DegreeTypeValue
Ord,Int -> DegreeTypeValue
DegreeTypeValue -> Int
DegreeTypeValue -> [DegreeTypeValue]
DegreeTypeValue -> DegreeTypeValue
DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
DegreeTypeValue
-> DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
(DegreeTypeValue -> DegreeTypeValue)
-> (DegreeTypeValue -> DegreeTypeValue)
-> (Int -> DegreeTypeValue)
-> (DegreeTypeValue -> Int)
-> (DegreeTypeValue -> [DegreeTypeValue])
-> (DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue])
-> (DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue])
-> (DegreeTypeValue
    -> DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue])
-> Enum DegreeTypeValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DegreeTypeValue
-> DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
$cenumFromThenTo :: DegreeTypeValue
-> DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
enumFromTo :: DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
$cenumFromTo :: DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
enumFromThen :: DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
$cenumFromThen :: DegreeTypeValue -> DegreeTypeValue -> [DegreeTypeValue]
enumFrom :: DegreeTypeValue -> [DegreeTypeValue]
$cenumFrom :: DegreeTypeValue -> [DegreeTypeValue]
fromEnum :: DegreeTypeValue -> Int
$cfromEnum :: DegreeTypeValue -> Int
toEnum :: Int -> DegreeTypeValue
$ctoEnum :: Int -> DegreeTypeValue
pred :: DegreeTypeValue -> DegreeTypeValue
$cpred :: DegreeTypeValue -> DegreeTypeValue
succ :: DegreeTypeValue -> DegreeTypeValue
$csucc :: DegreeTypeValue -> DegreeTypeValue
Enum,DegreeTypeValue
DegreeTypeValue -> DegreeTypeValue -> Bounded DegreeTypeValue
forall a. a -> a -> Bounded a
maxBound :: DegreeTypeValue
$cmaxBound :: DegreeTypeValue
minBound :: DegreeTypeValue
$cminBound :: DegreeTypeValue
Bounded)
instance EmitXml DegreeTypeValue where
    emitXml :: DegreeTypeValue -> XmlRep
emitXml DegreeTypeValue
DegreeTypeValueAdd = String -> XmlRep
XLit String
"add"
    emitXml DegreeTypeValue
DegreeTypeValueAlter = String -> XmlRep
XLit String
"alter"
    emitXml DegreeTypeValue
DegreeTypeValueSubtract = String -> XmlRep
XLit String
"subtract"
parseDegreeTypeValue :: String -> P.XParse DegreeTypeValue
parseDegreeTypeValue :: String -> XParse DegreeTypeValue
parseDegreeTypeValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"add" = DegreeTypeValue -> XParse DegreeTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeTypeValue -> XParse DegreeTypeValue)
-> DegreeTypeValue -> XParse DegreeTypeValue
forall a b. (a -> b) -> a -> b
$ DegreeTypeValue
DegreeTypeValueAdd
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"alter" = DegreeTypeValue -> XParse DegreeTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeTypeValue -> XParse DegreeTypeValue)
-> DegreeTypeValue -> XParse DegreeTypeValue
forall a b. (a -> b) -> a -> b
$ DegreeTypeValue
DegreeTypeValueAlter
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"subtract" = DegreeTypeValue -> XParse DegreeTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DegreeTypeValue -> XParse DegreeTypeValue)
-> DegreeTypeValue -> XParse DegreeTypeValue
forall a b. (a -> b) -> a -> b
$ DegreeTypeValue
DegreeTypeValueSubtract
        | Bool
otherwise = String -> XParse DegreeTypeValue
forall a. String -> XParse a
P.xfail (String -> XParse DegreeTypeValue)
-> String -> XParse DegreeTypeValue
forall a b. (a -> b) -> a -> b
$ String
"DegreeTypeValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @distance-type@ /(simple)/
--
-- The distance-type defines what type of distance is being defined in a distance element. Values include beam and hyphen. This is left as a string so that other application-specific types can be defined, but it is made a separate type so that it can be redefined more strictly.
newtype DistanceType = DistanceType { DistanceType -> Token
distanceType :: Token }
    deriving (DistanceType -> DistanceType -> Bool
(DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> Bool) -> Eq DistanceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistanceType -> DistanceType -> Bool
$c/= :: DistanceType -> DistanceType -> Bool
== :: DistanceType -> DistanceType -> Bool
$c== :: DistanceType -> DistanceType -> Bool
Eq,Typeable,(forall x. DistanceType -> Rep DistanceType x)
-> (forall x. Rep DistanceType x -> DistanceType)
-> Generic DistanceType
forall x. Rep DistanceType x -> DistanceType
forall x. DistanceType -> Rep DistanceType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DistanceType x -> DistanceType
$cfrom :: forall x. DistanceType -> Rep DistanceType x
Generic,Eq DistanceType
Eq DistanceType
-> (DistanceType -> DistanceType -> Ordering)
-> (DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> Bool)
-> (DistanceType -> DistanceType -> DistanceType)
-> (DistanceType -> DistanceType -> DistanceType)
-> Ord DistanceType
DistanceType -> DistanceType -> Bool
DistanceType -> DistanceType -> Ordering
DistanceType -> DistanceType -> DistanceType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DistanceType -> DistanceType -> DistanceType
$cmin :: DistanceType -> DistanceType -> DistanceType
max :: DistanceType -> DistanceType -> DistanceType
$cmax :: DistanceType -> DistanceType -> DistanceType
>= :: DistanceType -> DistanceType -> Bool
$c>= :: DistanceType -> DistanceType -> Bool
> :: DistanceType -> DistanceType -> Bool
$c> :: DistanceType -> DistanceType -> Bool
<= :: DistanceType -> DistanceType -> Bool
$c<= :: DistanceType -> DistanceType -> Bool
< :: DistanceType -> DistanceType -> Bool
$c< :: DistanceType -> DistanceType -> Bool
compare :: DistanceType -> DistanceType -> Ordering
$ccompare :: DistanceType -> DistanceType -> Ordering
$cp1Ord :: Eq DistanceType
Ord,String -> DistanceType
(String -> DistanceType) -> IsString DistanceType
forall a. (String -> a) -> IsString a
fromString :: String -> DistanceType
$cfromString :: String -> DistanceType
IsString)
instance Show DistanceType where show :: DistanceType -> String
show (DistanceType Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read DistanceType where readsPrec :: Int -> ReadS DistanceType
readsPrec Int
i = ((Token, String) -> (DistanceType, String))
-> [(Token, String)] -> [(DistanceType, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> DistanceType)
-> (Token, String) -> (DistanceType, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> DistanceType
DistanceType) ([(Token, String)] -> [(DistanceType, String)])
-> (String -> [(Token, String)]) -> ReadS DistanceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml DistanceType where
    emitXml :: DistanceType -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep)
-> (DistanceType -> Token) -> DistanceType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DistanceType -> Token
distanceType
parseDistanceType :: String -> P.XParse DistanceType
parseDistanceType :: String -> XParse DistanceType
parseDistanceType = DistanceType -> XParse DistanceType
forall (m :: * -> *) a. Monad m => a -> m a
return (DistanceType -> XParse DistanceType)
-> (String -> DistanceType) -> String -> XParse DistanceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> DistanceType
forall a. IsString a => String -> a
fromString

-- | @divisions@ /(simple)/
--
-- The divisions type is used to express values in terms of the musical divisions defined by the divisions element. It is preferred that these be integer values both for MIDI interoperability and to avoid roundoff errors.
newtype Divisions = Divisions { Divisions -> Decimal
divisions :: Decimal }
    deriving (Divisions -> Divisions -> Bool
(Divisions -> Divisions -> Bool)
-> (Divisions -> Divisions -> Bool) -> Eq Divisions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Divisions -> Divisions -> Bool
$c/= :: Divisions -> Divisions -> Bool
== :: Divisions -> Divisions -> Bool
$c== :: Divisions -> Divisions -> Bool
Eq,Typeable,(forall x. Divisions -> Rep Divisions x)
-> (forall x. Rep Divisions x -> Divisions) -> Generic Divisions
forall x. Rep Divisions x -> Divisions
forall x. Divisions -> Rep Divisions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Divisions x -> Divisions
$cfrom :: forall x. Divisions -> Rep Divisions x
Generic,Eq Divisions
Eq Divisions
-> (Divisions -> Divisions -> Ordering)
-> (Divisions -> Divisions -> Bool)
-> (Divisions -> Divisions -> Bool)
-> (Divisions -> Divisions -> Bool)
-> (Divisions -> Divisions -> Bool)
-> (Divisions -> Divisions -> Divisions)
-> (Divisions -> Divisions -> Divisions)
-> Ord Divisions
Divisions -> Divisions -> Bool
Divisions -> Divisions -> Ordering
Divisions -> Divisions -> Divisions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Divisions -> Divisions -> Divisions
$cmin :: Divisions -> Divisions -> Divisions
max :: Divisions -> Divisions -> Divisions
$cmax :: Divisions -> Divisions -> Divisions
>= :: Divisions -> Divisions -> Bool
$c>= :: Divisions -> Divisions -> Bool
> :: Divisions -> Divisions -> Bool
$c> :: Divisions -> Divisions -> Bool
<= :: Divisions -> Divisions -> Bool
$c<= :: Divisions -> Divisions -> Bool
< :: Divisions -> Divisions -> Bool
$c< :: Divisions -> Divisions -> Bool
compare :: Divisions -> Divisions -> Ordering
$ccompare :: Divisions -> Divisions -> Ordering
$cp1Ord :: Eq Divisions
Ord,Integer -> Divisions
Divisions -> Divisions
Divisions -> Divisions -> Divisions
(Divisions -> Divisions -> Divisions)
-> (Divisions -> Divisions -> Divisions)
-> (Divisions -> Divisions -> Divisions)
-> (Divisions -> Divisions)
-> (Divisions -> Divisions)
-> (Divisions -> Divisions)
-> (Integer -> Divisions)
-> Num Divisions
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Divisions
$cfromInteger :: Integer -> Divisions
signum :: Divisions -> Divisions
$csignum :: Divisions -> Divisions
abs :: Divisions -> Divisions
$cabs :: Divisions -> Divisions
negate :: Divisions -> Divisions
$cnegate :: Divisions -> Divisions
* :: Divisions -> Divisions -> Divisions
$c* :: Divisions -> Divisions -> Divisions
- :: Divisions -> Divisions -> Divisions
$c- :: Divisions -> Divisions -> Divisions
+ :: Divisions -> Divisions -> Divisions
$c+ :: Divisions -> Divisions -> Divisions
Num,Num Divisions
Ord Divisions
Num Divisions
-> Ord Divisions -> (Divisions -> Rational) -> Real Divisions
Divisions -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Divisions -> Rational
$ctoRational :: Divisions -> Rational
$cp2Real :: Ord Divisions
$cp1Real :: Num Divisions
Real,Num Divisions
Num Divisions
-> (Divisions -> Divisions -> Divisions)
-> (Divisions -> Divisions)
-> (Rational -> Divisions)
-> Fractional Divisions
Rational -> Divisions
Divisions -> Divisions
Divisions -> Divisions -> Divisions
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Divisions
$cfromRational :: Rational -> Divisions
recip :: Divisions -> Divisions
$crecip :: Divisions -> Divisions
/ :: Divisions -> Divisions -> Divisions
$c/ :: Divisions -> Divisions -> Divisions
$cp1Fractional :: Num Divisions
Fractional,Fractional Divisions
Real Divisions
Real Divisions
-> Fractional Divisions
-> (forall b. Integral b => Divisions -> (b, Divisions))
-> (forall b. Integral b => Divisions -> b)
-> (forall b. Integral b => Divisions -> b)
-> (forall b. Integral b => Divisions -> b)
-> (forall b. Integral b => Divisions -> b)
-> RealFrac Divisions
Divisions -> b
Divisions -> b
Divisions -> b
Divisions -> b
Divisions -> (b, Divisions)
forall b. Integral b => Divisions -> b
forall b. Integral b => Divisions -> (b, Divisions)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Divisions -> b
$cfloor :: forall b. Integral b => Divisions -> b
ceiling :: Divisions -> b
$cceiling :: forall b. Integral b => Divisions -> b
round :: Divisions -> b
$cround :: forall b. Integral b => Divisions -> b
truncate :: Divisions -> b
$ctruncate :: forall b. Integral b => Divisions -> b
properFraction :: Divisions -> (b, Divisions)
$cproperFraction :: forall b. Integral b => Divisions -> (b, Divisions)
$cp2RealFrac :: Fractional Divisions
$cp1RealFrac :: Real Divisions
RealFrac)
instance Show Divisions where show :: Divisions -> String
show (Divisions Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read Divisions where readsPrec :: Int -> ReadS Divisions
readsPrec Int
i = ((Decimal, String) -> (Divisions, String))
-> [(Decimal, String)] -> [(Divisions, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> Divisions) -> (Decimal, String) -> (Divisions, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> Divisions
Divisions) ([(Decimal, String)] -> [(Divisions, String)])
-> (String -> [(Decimal, String)]) -> ReadS Divisions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Divisions where
    emitXml :: Divisions -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (Divisions -> Decimal) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Divisions -> Decimal
divisions
parseDivisions :: String -> P.XParse Divisions
parseDivisions :: String -> XParse Divisions
parseDivisions = String -> String -> XParse Divisions
forall a. Read a => String -> String -> XParse a
P.xread String
"Divisions"

-- | @effect@ /(simple)/
--
-- The effect type represents pictograms for sound effect percussion instruments. The cannon, lotus flute, and megaphone values are in addition to Stone's list.
data Effect = 
      EffectAnvil -- ^ /anvil/
    | EffectAutoHorn -- ^ /auto horn/
    | EffectBirdWhistle -- ^ /bird whistle/
    | EffectCannon -- ^ /cannon/
    | EffectDuckCall -- ^ /duck call/
    | EffectGunShot -- ^ /gun shot/
    | EffectKlaxonHorn -- ^ /klaxon horn/
    | EffectLionsRoar -- ^ /lions roar/
    | EffectLotusFlute -- ^ /lotus flute/
    | EffectMegaphone -- ^ /megaphone/
    | EffectPoliceWhistle -- ^ /police whistle/
    | EffectSiren -- ^ /siren/
    | EffectSlideWhistle -- ^ /slide whistle/
    | EffectThunderSheet -- ^ /thunder sheet/
    | EffectWindMachine -- ^ /wind machine/
    | EffectWindWhistle -- ^ /wind whistle/
    deriving (Effect -> Effect -> Bool
(Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool) -> Eq Effect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c== :: Effect -> Effect -> Bool
Eq,Typeable,(forall x. Effect -> Rep Effect x)
-> (forall x. Rep Effect x -> Effect) -> Generic Effect
forall x. Rep Effect x -> Effect
forall x. Effect -> Rep Effect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Effect x -> Effect
$cfrom :: forall x. Effect -> Rep Effect x
Generic,Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> String
(Int -> Effect -> ShowS)
-> (Effect -> String) -> ([Effect] -> ShowS) -> Show Effect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Effect] -> ShowS
$cshowList :: [Effect] -> ShowS
show :: Effect -> String
$cshow :: Effect -> String
showsPrec :: Int -> Effect -> ShowS
$cshowsPrec :: Int -> Effect -> ShowS
Show,Eq Effect
Eq Effect
-> (Effect -> Effect -> Ordering)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Effect)
-> (Effect -> Effect -> Effect)
-> Ord Effect
Effect -> Effect -> Bool
Effect -> Effect -> Ordering
Effect -> Effect -> Effect
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Effect -> Effect -> Effect
$cmin :: Effect -> Effect -> Effect
max :: Effect -> Effect -> Effect
$cmax :: Effect -> Effect -> Effect
>= :: Effect -> Effect -> Bool
$c>= :: Effect -> Effect -> Bool
> :: Effect -> Effect -> Bool
$c> :: Effect -> Effect -> Bool
<= :: Effect -> Effect -> Bool
$c<= :: Effect -> Effect -> Bool
< :: Effect -> Effect -> Bool
$c< :: Effect -> Effect -> Bool
compare :: Effect -> Effect -> Ordering
$ccompare :: Effect -> Effect -> Ordering
$cp1Ord :: Eq Effect
Ord,Int -> Effect
Effect -> Int
Effect -> [Effect]
Effect -> Effect
Effect -> Effect -> [Effect]
Effect -> Effect -> Effect -> [Effect]
(Effect -> Effect)
-> (Effect -> Effect)
-> (Int -> Effect)
-> (Effect -> Int)
-> (Effect -> [Effect])
-> (Effect -> Effect -> [Effect])
-> (Effect -> Effect -> [Effect])
-> (Effect -> Effect -> Effect -> [Effect])
-> Enum Effect
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Effect -> Effect -> Effect -> [Effect]
$cenumFromThenTo :: Effect -> Effect -> Effect -> [Effect]
enumFromTo :: Effect -> Effect -> [Effect]
$cenumFromTo :: Effect -> Effect -> [Effect]
enumFromThen :: Effect -> Effect -> [Effect]
$cenumFromThen :: Effect -> Effect -> [Effect]
enumFrom :: Effect -> [Effect]
$cenumFrom :: Effect -> [Effect]
fromEnum :: Effect -> Int
$cfromEnum :: Effect -> Int
toEnum :: Int -> Effect
$ctoEnum :: Int -> Effect
pred :: Effect -> Effect
$cpred :: Effect -> Effect
succ :: Effect -> Effect
$csucc :: Effect -> Effect
Enum,Effect
Effect -> Effect -> Bounded Effect
forall a. a -> a -> Bounded a
maxBound :: Effect
$cmaxBound :: Effect
minBound :: Effect
$cminBound :: Effect
Bounded)
instance EmitXml Effect where
    emitXml :: Effect -> XmlRep
emitXml Effect
EffectAnvil = String -> XmlRep
XLit String
"anvil"
    emitXml Effect
EffectAutoHorn = String -> XmlRep
XLit String
"auto horn"
    emitXml Effect
EffectBirdWhistle = String -> XmlRep
XLit String
"bird whistle"
    emitXml Effect
EffectCannon = String -> XmlRep
XLit String
"cannon"
    emitXml Effect
EffectDuckCall = String -> XmlRep
XLit String
"duck call"
    emitXml Effect
EffectGunShot = String -> XmlRep
XLit String
"gun shot"
    emitXml Effect
EffectKlaxonHorn = String -> XmlRep
XLit String
"klaxon horn"
    emitXml Effect
EffectLionsRoar = String -> XmlRep
XLit String
"lions roar"
    emitXml Effect
EffectLotusFlute = String -> XmlRep
XLit String
"lotus flute"
    emitXml Effect
EffectMegaphone = String -> XmlRep
XLit String
"megaphone"
    emitXml Effect
EffectPoliceWhistle = String -> XmlRep
XLit String
"police whistle"
    emitXml Effect
EffectSiren = String -> XmlRep
XLit String
"siren"
    emitXml Effect
EffectSlideWhistle = String -> XmlRep
XLit String
"slide whistle"
    emitXml Effect
EffectThunderSheet = String -> XmlRep
XLit String
"thunder sheet"
    emitXml Effect
EffectWindMachine = String -> XmlRep
XLit String
"wind machine"
    emitXml Effect
EffectWindWhistle = String -> XmlRep
XLit String
"wind whistle"
parseEffect :: String -> P.XParse Effect
parseEffect :: String -> XParse Effect
parseEffect String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"anvil" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectAnvil
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"auto horn" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectAutoHorn
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bird whistle" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectBirdWhistle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cannon" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectCannon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"duck call" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectDuckCall
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"gun shot" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectGunShot
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"klaxon horn" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectKlaxonHorn
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"lions roar" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectLionsRoar
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"lotus flute" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectLotusFlute
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"megaphone" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectMegaphone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"police whistle" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectPoliceWhistle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"siren" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectSiren
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slide whistle" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectSlideWhistle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"thunder sheet" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectThunderSheet
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wind machine" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectWindMachine
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wind whistle" = Effect -> XParse Effect
forall (m :: * -> *) a. Monad m => a -> m a
return (Effect -> XParse Effect) -> Effect -> XParse Effect
forall a b. (a -> b) -> a -> b
$ Effect
EffectWindWhistle
        | Bool
otherwise = String -> XParse Effect
forall a. String -> XParse a
P.xfail (String -> XParse Effect) -> String -> XParse Effect
forall a b. (a -> b) -> a -> b
$ String
"Effect: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @enclosure-shape@ /(simple)/
--
-- The enclosure-shape type describes the shape and presence / absence of an enclosure around text or symbols. A bracket enclosure is similar to a rectangle with the bottom line missing, as is common in jazz notation.
data EnclosureShape = 
      EnclosureShapeRectangle -- ^ /rectangle/
    | EnclosureShapeSquare -- ^ /square/
    | EnclosureShapeOval -- ^ /oval/
    | EnclosureShapeCircle -- ^ /circle/
    | EnclosureShapeBracket -- ^ /bracket/
    | EnclosureShapeTriangle -- ^ /triangle/
    | EnclosureShapeDiamond -- ^ /diamond/
    | EnclosureShapePentagon -- ^ /pentagon/
    | EnclosureShapeHexagon -- ^ /hexagon/
    | EnclosureShapeHeptagon -- ^ /heptagon/
    | EnclosureShapeOctagon -- ^ /octagon/
    | EnclosureShapeNonagon -- ^ /nonagon/
    | EnclosureShapeDecagon -- ^ /decagon/
    | EnclosureShapeNone -- ^ /none/
    deriving (EnclosureShape -> EnclosureShape -> Bool
(EnclosureShape -> EnclosureShape -> Bool)
-> (EnclosureShape -> EnclosureShape -> Bool) -> Eq EnclosureShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnclosureShape -> EnclosureShape -> Bool
$c/= :: EnclosureShape -> EnclosureShape -> Bool
== :: EnclosureShape -> EnclosureShape -> Bool
$c== :: EnclosureShape -> EnclosureShape -> Bool
Eq,Typeable,(forall x. EnclosureShape -> Rep EnclosureShape x)
-> (forall x. Rep EnclosureShape x -> EnclosureShape)
-> Generic EnclosureShape
forall x. Rep EnclosureShape x -> EnclosureShape
forall x. EnclosureShape -> Rep EnclosureShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnclosureShape x -> EnclosureShape
$cfrom :: forall x. EnclosureShape -> Rep EnclosureShape x
Generic,Int -> EnclosureShape -> ShowS
[EnclosureShape] -> ShowS
EnclosureShape -> String
(Int -> EnclosureShape -> ShowS)
-> (EnclosureShape -> String)
-> ([EnclosureShape] -> ShowS)
-> Show EnclosureShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnclosureShape] -> ShowS
$cshowList :: [EnclosureShape] -> ShowS
show :: EnclosureShape -> String
$cshow :: EnclosureShape -> String
showsPrec :: Int -> EnclosureShape -> ShowS
$cshowsPrec :: Int -> EnclosureShape -> ShowS
Show,Eq EnclosureShape
Eq EnclosureShape
-> (EnclosureShape -> EnclosureShape -> Ordering)
-> (EnclosureShape -> EnclosureShape -> Bool)
-> (EnclosureShape -> EnclosureShape -> Bool)
-> (EnclosureShape -> EnclosureShape -> Bool)
-> (EnclosureShape -> EnclosureShape -> Bool)
-> (EnclosureShape -> EnclosureShape -> EnclosureShape)
-> (EnclosureShape -> EnclosureShape -> EnclosureShape)
-> Ord EnclosureShape
EnclosureShape -> EnclosureShape -> Bool
EnclosureShape -> EnclosureShape -> Ordering
EnclosureShape -> EnclosureShape -> EnclosureShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EnclosureShape -> EnclosureShape -> EnclosureShape
$cmin :: EnclosureShape -> EnclosureShape -> EnclosureShape
max :: EnclosureShape -> EnclosureShape -> EnclosureShape
$cmax :: EnclosureShape -> EnclosureShape -> EnclosureShape
>= :: EnclosureShape -> EnclosureShape -> Bool
$c>= :: EnclosureShape -> EnclosureShape -> Bool
> :: EnclosureShape -> EnclosureShape -> Bool
$c> :: EnclosureShape -> EnclosureShape -> Bool
<= :: EnclosureShape -> EnclosureShape -> Bool
$c<= :: EnclosureShape -> EnclosureShape -> Bool
< :: EnclosureShape -> EnclosureShape -> Bool
$c< :: EnclosureShape -> EnclosureShape -> Bool
compare :: EnclosureShape -> EnclosureShape -> Ordering
$ccompare :: EnclosureShape -> EnclosureShape -> Ordering
$cp1Ord :: Eq EnclosureShape
Ord,Int -> EnclosureShape
EnclosureShape -> Int
EnclosureShape -> [EnclosureShape]
EnclosureShape -> EnclosureShape
EnclosureShape -> EnclosureShape -> [EnclosureShape]
EnclosureShape
-> EnclosureShape -> EnclosureShape -> [EnclosureShape]
(EnclosureShape -> EnclosureShape)
-> (EnclosureShape -> EnclosureShape)
-> (Int -> EnclosureShape)
-> (EnclosureShape -> Int)
-> (EnclosureShape -> [EnclosureShape])
-> (EnclosureShape -> EnclosureShape -> [EnclosureShape])
-> (EnclosureShape -> EnclosureShape -> [EnclosureShape])
-> (EnclosureShape
    -> EnclosureShape -> EnclosureShape -> [EnclosureShape])
-> Enum EnclosureShape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EnclosureShape
-> EnclosureShape -> EnclosureShape -> [EnclosureShape]
$cenumFromThenTo :: EnclosureShape
-> EnclosureShape -> EnclosureShape -> [EnclosureShape]
enumFromTo :: EnclosureShape -> EnclosureShape -> [EnclosureShape]
$cenumFromTo :: EnclosureShape -> EnclosureShape -> [EnclosureShape]
enumFromThen :: EnclosureShape -> EnclosureShape -> [EnclosureShape]
$cenumFromThen :: EnclosureShape -> EnclosureShape -> [EnclosureShape]
enumFrom :: EnclosureShape -> [EnclosureShape]
$cenumFrom :: EnclosureShape -> [EnclosureShape]
fromEnum :: EnclosureShape -> Int
$cfromEnum :: EnclosureShape -> Int
toEnum :: Int -> EnclosureShape
$ctoEnum :: Int -> EnclosureShape
pred :: EnclosureShape -> EnclosureShape
$cpred :: EnclosureShape -> EnclosureShape
succ :: EnclosureShape -> EnclosureShape
$csucc :: EnclosureShape -> EnclosureShape
Enum,EnclosureShape
EnclosureShape -> EnclosureShape -> Bounded EnclosureShape
forall a. a -> a -> Bounded a
maxBound :: EnclosureShape
$cmaxBound :: EnclosureShape
minBound :: EnclosureShape
$cminBound :: EnclosureShape
Bounded)
instance EmitXml EnclosureShape where
    emitXml :: EnclosureShape -> XmlRep
emitXml EnclosureShape
EnclosureShapeRectangle = String -> XmlRep
XLit String
"rectangle"
    emitXml EnclosureShape
EnclosureShapeSquare = String -> XmlRep
XLit String
"square"
    emitXml EnclosureShape
EnclosureShapeOval = String -> XmlRep
XLit String
"oval"
    emitXml EnclosureShape
EnclosureShapeCircle = String -> XmlRep
XLit String
"circle"
    emitXml EnclosureShape
EnclosureShapeBracket = String -> XmlRep
XLit String
"bracket"
    emitXml EnclosureShape
EnclosureShapeTriangle = String -> XmlRep
XLit String
"triangle"
    emitXml EnclosureShape
EnclosureShapeDiamond = String -> XmlRep
XLit String
"diamond"
    emitXml EnclosureShape
EnclosureShapePentagon = String -> XmlRep
XLit String
"pentagon"
    emitXml EnclosureShape
EnclosureShapeHexagon = String -> XmlRep
XLit String
"hexagon"
    emitXml EnclosureShape
EnclosureShapeHeptagon = String -> XmlRep
XLit String
"heptagon"
    emitXml EnclosureShape
EnclosureShapeOctagon = String -> XmlRep
XLit String
"octagon"
    emitXml EnclosureShape
EnclosureShapeNonagon = String -> XmlRep
XLit String
"nonagon"
    emitXml EnclosureShape
EnclosureShapeDecagon = String -> XmlRep
XLit String
"decagon"
    emitXml EnclosureShape
EnclosureShapeNone = String -> XmlRep
XLit String
"none"
parseEnclosureShape :: String -> P.XParse EnclosureShape
parseEnclosureShape :: String -> XParse EnclosureShape
parseEnclosureShape String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rectangle" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeRectangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"square" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeSquare
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"oval" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeOval
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"circle" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeCircle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bracket" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeBracket
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triangle" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeTriangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diamond" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeDiamond
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"pentagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapePentagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hexagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeHexagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"heptagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeHeptagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"octagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeOctagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"nonagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeNonagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"decagon" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeDecagon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = EnclosureShape -> XParse EnclosureShape
forall (m :: * -> *) a. Monad m => a -> m a
return (EnclosureShape -> XParse EnclosureShape)
-> EnclosureShape -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ EnclosureShape
EnclosureShapeNone
        | Bool
otherwise = String -> XParse EnclosureShape
forall a. String -> XParse a
P.xfail (String -> XParse EnclosureShape)
-> String -> XParse EnclosureShape
forall a b. (a -> b) -> a -> b
$ String
"EnclosureShape: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @ending-number@ /(simple)/
--
-- The ending-number type is used to specify either a comma-separated list of positive integers without leading zeros, or a string of zero or more spaces. It is used for the number attribute of the ending element. The zero or more spaces version is used when software knows that an ending is present, but cannot determine the type of the ending.
newtype EndingNumber = EndingNumber { EndingNumber -> Token
endingNumber :: Token }
    deriving (EndingNumber -> EndingNumber -> Bool
(EndingNumber -> EndingNumber -> Bool)
-> (EndingNumber -> EndingNumber -> Bool) -> Eq EndingNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndingNumber -> EndingNumber -> Bool
$c/= :: EndingNumber -> EndingNumber -> Bool
== :: EndingNumber -> EndingNumber -> Bool
$c== :: EndingNumber -> EndingNumber -> Bool
Eq,Typeable,(forall x. EndingNumber -> Rep EndingNumber x)
-> (forall x. Rep EndingNumber x -> EndingNumber)
-> Generic EndingNumber
forall x. Rep EndingNumber x -> EndingNumber
forall x. EndingNumber -> Rep EndingNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EndingNumber x -> EndingNumber
$cfrom :: forall x. EndingNumber -> Rep EndingNumber x
Generic,Eq EndingNumber
Eq EndingNumber
-> (EndingNumber -> EndingNumber -> Ordering)
-> (EndingNumber -> EndingNumber -> Bool)
-> (EndingNumber -> EndingNumber -> Bool)
-> (EndingNumber -> EndingNumber -> Bool)
-> (EndingNumber -> EndingNumber -> Bool)
-> (EndingNumber -> EndingNumber -> EndingNumber)
-> (EndingNumber -> EndingNumber -> EndingNumber)
-> Ord EndingNumber
EndingNumber -> EndingNumber -> Bool
EndingNumber -> EndingNumber -> Ordering
EndingNumber -> EndingNumber -> EndingNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EndingNumber -> EndingNumber -> EndingNumber
$cmin :: EndingNumber -> EndingNumber -> EndingNumber
max :: EndingNumber -> EndingNumber -> EndingNumber
$cmax :: EndingNumber -> EndingNumber -> EndingNumber
>= :: EndingNumber -> EndingNumber -> Bool
$c>= :: EndingNumber -> EndingNumber -> Bool
> :: EndingNumber -> EndingNumber -> Bool
$c> :: EndingNumber -> EndingNumber -> Bool
<= :: EndingNumber -> EndingNumber -> Bool
$c<= :: EndingNumber -> EndingNumber -> Bool
< :: EndingNumber -> EndingNumber -> Bool
$c< :: EndingNumber -> EndingNumber -> Bool
compare :: EndingNumber -> EndingNumber -> Ordering
$ccompare :: EndingNumber -> EndingNumber -> Ordering
$cp1Ord :: Eq EndingNumber
Ord,String -> EndingNumber
(String -> EndingNumber) -> IsString EndingNumber
forall a. (String -> a) -> IsString a
fromString :: String -> EndingNumber
$cfromString :: String -> EndingNumber
IsString)
instance Show EndingNumber where show :: EndingNumber -> String
show (EndingNumber Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read EndingNumber where readsPrec :: Int -> ReadS EndingNumber
readsPrec Int
i = ((Token, String) -> (EndingNumber, String))
-> [(Token, String)] -> [(EndingNumber, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> EndingNumber)
-> (Token, String) -> (EndingNumber, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> EndingNumber
EndingNumber) ([(Token, String)] -> [(EndingNumber, String)])
-> (String -> [(Token, String)]) -> ReadS EndingNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml EndingNumber where
    emitXml :: EndingNumber -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep)
-> (EndingNumber -> Token) -> EndingNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndingNumber -> Token
endingNumber
parseEndingNumber :: String -> P.XParse EndingNumber
parseEndingNumber :: String -> XParse EndingNumber
parseEndingNumber = EndingNumber -> XParse EndingNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (EndingNumber -> XParse EndingNumber)
-> (String -> EndingNumber) -> String -> XParse EndingNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> EndingNumber
forall a. IsString a => String -> a
fromString

-- | @fan@ /(simple)/
--
-- The fan type represents the type of beam fanning present on a note, used to represent accelerandos and ritardandos.
data Fan = 
      FanAccel -- ^ /accel/
    | FanRit -- ^ /rit/
    | FanNone -- ^ /none/
    deriving (Fan -> Fan -> Bool
(Fan -> Fan -> Bool) -> (Fan -> Fan -> Bool) -> Eq Fan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fan -> Fan -> Bool
$c/= :: Fan -> Fan -> Bool
== :: Fan -> Fan -> Bool
$c== :: Fan -> Fan -> Bool
Eq,Typeable,(forall x. Fan -> Rep Fan x)
-> (forall x. Rep Fan x -> Fan) -> Generic Fan
forall x. Rep Fan x -> Fan
forall x. Fan -> Rep Fan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fan x -> Fan
$cfrom :: forall x. Fan -> Rep Fan x
Generic,Int -> Fan -> ShowS
[Fan] -> ShowS
Fan -> String
(Int -> Fan -> ShowS)
-> (Fan -> String) -> ([Fan] -> ShowS) -> Show Fan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fan] -> ShowS
$cshowList :: [Fan] -> ShowS
show :: Fan -> String
$cshow :: Fan -> String
showsPrec :: Int -> Fan -> ShowS
$cshowsPrec :: Int -> Fan -> ShowS
Show,Eq Fan
Eq Fan
-> (Fan -> Fan -> Ordering)
-> (Fan -> Fan -> Bool)
-> (Fan -> Fan -> Bool)
-> (Fan -> Fan -> Bool)
-> (Fan -> Fan -> Bool)
-> (Fan -> Fan -> Fan)
-> (Fan -> Fan -> Fan)
-> Ord Fan
Fan -> Fan -> Bool
Fan -> Fan -> Ordering
Fan -> Fan -> Fan
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fan -> Fan -> Fan
$cmin :: Fan -> Fan -> Fan
max :: Fan -> Fan -> Fan
$cmax :: Fan -> Fan -> Fan
>= :: Fan -> Fan -> Bool
$c>= :: Fan -> Fan -> Bool
> :: Fan -> Fan -> Bool
$c> :: Fan -> Fan -> Bool
<= :: Fan -> Fan -> Bool
$c<= :: Fan -> Fan -> Bool
< :: Fan -> Fan -> Bool
$c< :: Fan -> Fan -> Bool
compare :: Fan -> Fan -> Ordering
$ccompare :: Fan -> Fan -> Ordering
$cp1Ord :: Eq Fan
Ord,Int -> Fan
Fan -> Int
Fan -> [Fan]
Fan -> Fan
Fan -> Fan -> [Fan]
Fan -> Fan -> Fan -> [Fan]
(Fan -> Fan)
-> (Fan -> Fan)
-> (Int -> Fan)
-> (Fan -> Int)
-> (Fan -> [Fan])
-> (Fan -> Fan -> [Fan])
-> (Fan -> Fan -> [Fan])
-> (Fan -> Fan -> Fan -> [Fan])
-> Enum Fan
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fan -> Fan -> Fan -> [Fan]
$cenumFromThenTo :: Fan -> Fan -> Fan -> [Fan]
enumFromTo :: Fan -> Fan -> [Fan]
$cenumFromTo :: Fan -> Fan -> [Fan]
enumFromThen :: Fan -> Fan -> [Fan]
$cenumFromThen :: Fan -> Fan -> [Fan]
enumFrom :: Fan -> [Fan]
$cenumFrom :: Fan -> [Fan]
fromEnum :: Fan -> Int
$cfromEnum :: Fan -> Int
toEnum :: Int -> Fan
$ctoEnum :: Int -> Fan
pred :: Fan -> Fan
$cpred :: Fan -> Fan
succ :: Fan -> Fan
$csucc :: Fan -> Fan
Enum,Fan
Fan -> Fan -> Bounded Fan
forall a. a -> a -> Bounded a
maxBound :: Fan
$cmaxBound :: Fan
minBound :: Fan
$cminBound :: Fan
Bounded)
instance EmitXml Fan where
    emitXml :: Fan -> XmlRep
emitXml Fan
FanAccel = String -> XmlRep
XLit String
"accel"
    emitXml Fan
FanRit = String -> XmlRep
XLit String
"rit"
    emitXml Fan
FanNone = String -> XmlRep
XLit String
"none"
parseFan :: String -> P.XParse Fan
parseFan :: String -> XParse Fan
parseFan String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"accel" = Fan -> XParse Fan
forall (m :: * -> *) a. Monad m => a -> m a
return (Fan -> XParse Fan) -> Fan -> XParse Fan
forall a b. (a -> b) -> a -> b
$ Fan
FanAccel
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rit" = Fan -> XParse Fan
forall (m :: * -> *) a. Monad m => a -> m a
return (Fan -> XParse Fan) -> Fan -> XParse Fan
forall a b. (a -> b) -> a -> b
$ Fan
FanRit
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = Fan -> XParse Fan
forall (m :: * -> *) a. Monad m => a -> m a
return (Fan -> XParse Fan) -> Fan -> XParse Fan
forall a b. (a -> b) -> a -> b
$ Fan
FanNone
        | Bool
otherwise = String -> XParse Fan
forall a. String -> XParse a
P.xfail (String -> XParse Fan) -> String -> XParse Fan
forall a b. (a -> b) -> a -> b
$ String
"Fan: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @fermata-shape@ /(simple)/
--
-- The fermata-shape type represents the shape of the fermata sign. The empty value is equivalent to the normal value.
data FermataShape = 
      FermataShapeNormal -- ^ /normal/
    | FermataShapeAngled -- ^ /angled/
    | FermataShapeSquare -- ^ /square/
    | FermataShapeDoubleAngled -- ^ /double-angled/
    | FermataShapeDoubleSquare -- ^ /double-square/
    | FermataShapeDoubleDot -- ^ /double-dot/
    | FermataShapeHalfCurve -- ^ /half-curve/
    | FermataShapeCurlew -- ^ /curlew/
    | FermataShape -- ^ //
    deriving (FermataShape -> FermataShape -> Bool
(FermataShape -> FermataShape -> Bool)
-> (FermataShape -> FermataShape -> Bool) -> Eq FermataShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FermataShape -> FermataShape -> Bool
$c/= :: FermataShape -> FermataShape -> Bool
== :: FermataShape -> FermataShape -> Bool
$c== :: FermataShape -> FermataShape -> Bool
Eq,Typeable,(forall x. FermataShape -> Rep FermataShape x)
-> (forall x. Rep FermataShape x -> FermataShape)
-> Generic FermataShape
forall x. Rep FermataShape x -> FermataShape
forall x. FermataShape -> Rep FermataShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FermataShape x -> FermataShape
$cfrom :: forall x. FermataShape -> Rep FermataShape x
Generic,Int -> FermataShape -> ShowS
[FermataShape] -> ShowS
FermataShape -> String
(Int -> FermataShape -> ShowS)
-> (FermataShape -> String)
-> ([FermataShape] -> ShowS)
-> Show FermataShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FermataShape] -> ShowS
$cshowList :: [FermataShape] -> ShowS
show :: FermataShape -> String
$cshow :: FermataShape -> String
showsPrec :: Int -> FermataShape -> ShowS
$cshowsPrec :: Int -> FermataShape -> ShowS
Show,Eq FermataShape
Eq FermataShape
-> (FermataShape -> FermataShape -> Ordering)
-> (FermataShape -> FermataShape -> Bool)
-> (FermataShape -> FermataShape -> Bool)
-> (FermataShape -> FermataShape -> Bool)
-> (FermataShape -> FermataShape -> Bool)
-> (FermataShape -> FermataShape -> FermataShape)
-> (FermataShape -> FermataShape -> FermataShape)
-> Ord FermataShape
FermataShape -> FermataShape -> Bool
FermataShape -> FermataShape -> Ordering
FermataShape -> FermataShape -> FermataShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FermataShape -> FermataShape -> FermataShape
$cmin :: FermataShape -> FermataShape -> FermataShape
max :: FermataShape -> FermataShape -> FermataShape
$cmax :: FermataShape -> FermataShape -> FermataShape
>= :: FermataShape -> FermataShape -> Bool
$c>= :: FermataShape -> FermataShape -> Bool
> :: FermataShape -> FermataShape -> Bool
$c> :: FermataShape -> FermataShape -> Bool
<= :: FermataShape -> FermataShape -> Bool
$c<= :: FermataShape -> FermataShape -> Bool
< :: FermataShape -> FermataShape -> Bool
$c< :: FermataShape -> FermataShape -> Bool
compare :: FermataShape -> FermataShape -> Ordering
$ccompare :: FermataShape -> FermataShape -> Ordering
$cp1Ord :: Eq FermataShape
Ord,Int -> FermataShape
FermataShape -> Int
FermataShape -> [FermataShape]
FermataShape -> FermataShape
FermataShape -> FermataShape -> [FermataShape]
FermataShape -> FermataShape -> FermataShape -> [FermataShape]
(FermataShape -> FermataShape)
-> (FermataShape -> FermataShape)
-> (Int -> FermataShape)
-> (FermataShape -> Int)
-> (FermataShape -> [FermataShape])
-> (FermataShape -> FermataShape -> [FermataShape])
-> (FermataShape -> FermataShape -> [FermataShape])
-> (FermataShape -> FermataShape -> FermataShape -> [FermataShape])
-> Enum FermataShape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FermataShape -> FermataShape -> FermataShape -> [FermataShape]
$cenumFromThenTo :: FermataShape -> FermataShape -> FermataShape -> [FermataShape]
enumFromTo :: FermataShape -> FermataShape -> [FermataShape]
$cenumFromTo :: FermataShape -> FermataShape -> [FermataShape]
enumFromThen :: FermataShape -> FermataShape -> [FermataShape]
$cenumFromThen :: FermataShape -> FermataShape -> [FermataShape]
enumFrom :: FermataShape -> [FermataShape]
$cenumFrom :: FermataShape -> [FermataShape]
fromEnum :: FermataShape -> Int
$cfromEnum :: FermataShape -> Int
toEnum :: Int -> FermataShape
$ctoEnum :: Int -> FermataShape
pred :: FermataShape -> FermataShape
$cpred :: FermataShape -> FermataShape
succ :: FermataShape -> FermataShape
$csucc :: FermataShape -> FermataShape
Enum,FermataShape
FermataShape -> FermataShape -> Bounded FermataShape
forall a. a -> a -> Bounded a
maxBound :: FermataShape
$cmaxBound :: FermataShape
minBound :: FermataShape
$cminBound :: FermataShape
Bounded)
instance EmitXml FermataShape where
    emitXml :: FermataShape -> XmlRep
emitXml FermataShape
FermataShapeNormal = String -> XmlRep
XLit String
"normal"
    emitXml FermataShape
FermataShapeAngled = String -> XmlRep
XLit String
"angled"
    emitXml FermataShape
FermataShapeSquare = String -> XmlRep
XLit String
"square"
    emitXml FermataShape
FermataShapeDoubleAngled = String -> XmlRep
XLit String
"double-angled"
    emitXml FermataShape
FermataShapeDoubleSquare = String -> XmlRep
XLit String
"double-square"
    emitXml FermataShape
FermataShapeDoubleDot = String -> XmlRep
XLit String
"double-dot"
    emitXml FermataShape
FermataShapeHalfCurve = String -> XmlRep
XLit String
"half-curve"
    emitXml FermataShape
FermataShapeCurlew = String -> XmlRep
XLit String
"curlew"
    emitXml FermataShape
FermataShape = String -> XmlRep
XLit String
""
parseFermataShape :: String -> P.XParse FermataShape
parseFermataShape :: String -> XParse FermataShape
parseFermataShape String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeNormal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"angled" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeAngled
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"square" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeSquare
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-angled" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeDoubleAngled
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-square" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeDoubleSquare
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-dot" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeDoubleDot
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half-curve" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeHalfCurve
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"curlew" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShapeCurlew
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = FermataShape -> XParse FermataShape
forall (m :: * -> *) a. Monad m => a -> m a
return (FermataShape -> XParse FermataShape)
-> FermataShape -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ FermataShape
FermataShape
        | Bool
otherwise = String -> XParse FermataShape
forall a. String -> XParse a
P.xfail (String -> XParse FermataShape) -> String -> XParse FermataShape
forall a b. (a -> b) -> a -> b
$ String
"FermataShape: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @fifths@ /(simple)/
--
-- The fifths type represents the number of flats or sharps in a traditional key signature. Negative numbers are used for flats and positive numbers for sharps, reflecting the key's placement within the circle of fifths (hence the type name).
newtype Fifths = Fifths { Fifths -> Int
fifths :: Int }
    deriving (Fifths -> Fifths -> Bool
(Fifths -> Fifths -> Bool)
-> (Fifths -> Fifths -> Bool) -> Eq Fifths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fifths -> Fifths -> Bool
$c/= :: Fifths -> Fifths -> Bool
== :: Fifths -> Fifths -> Bool
$c== :: Fifths -> Fifths -> Bool
Eq,Typeable,(forall x. Fifths -> Rep Fifths x)
-> (forall x. Rep Fifths x -> Fifths) -> Generic Fifths
forall x. Rep Fifths x -> Fifths
forall x. Fifths -> Rep Fifths x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fifths x -> Fifths
$cfrom :: forall x. Fifths -> Rep Fifths x
Generic,Eq Fifths
Eq Fifths
-> (Fifths -> Fifths -> Ordering)
-> (Fifths -> Fifths -> Bool)
-> (Fifths -> Fifths -> Bool)
-> (Fifths -> Fifths -> Bool)
-> (Fifths -> Fifths -> Bool)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> Ord Fifths
Fifths -> Fifths -> Bool
Fifths -> Fifths -> Ordering
Fifths -> Fifths -> Fifths
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fifths -> Fifths -> Fifths
$cmin :: Fifths -> Fifths -> Fifths
max :: Fifths -> Fifths -> Fifths
$cmax :: Fifths -> Fifths -> Fifths
>= :: Fifths -> Fifths -> Bool
$c>= :: Fifths -> Fifths -> Bool
> :: Fifths -> Fifths -> Bool
$c> :: Fifths -> Fifths -> Bool
<= :: Fifths -> Fifths -> Bool
$c<= :: Fifths -> Fifths -> Bool
< :: Fifths -> Fifths -> Bool
$c< :: Fifths -> Fifths -> Bool
compare :: Fifths -> Fifths -> Ordering
$ccompare :: Fifths -> Fifths -> Ordering
$cp1Ord :: Eq Fifths
Ord,Fifths
Fifths -> Fifths -> Bounded Fifths
forall a. a -> a -> Bounded a
maxBound :: Fifths
$cmaxBound :: Fifths
minBound :: Fifths
$cminBound :: Fifths
Bounded,Int -> Fifths
Fifths -> Int
Fifths -> [Fifths]
Fifths -> Fifths
Fifths -> Fifths -> [Fifths]
Fifths -> Fifths -> Fifths -> [Fifths]
(Fifths -> Fifths)
-> (Fifths -> Fifths)
-> (Int -> Fifths)
-> (Fifths -> Int)
-> (Fifths -> [Fifths])
-> (Fifths -> Fifths -> [Fifths])
-> (Fifths -> Fifths -> [Fifths])
-> (Fifths -> Fifths -> Fifths -> [Fifths])
-> Enum Fifths
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fifths -> Fifths -> Fifths -> [Fifths]
$cenumFromThenTo :: Fifths -> Fifths -> Fifths -> [Fifths]
enumFromTo :: Fifths -> Fifths -> [Fifths]
$cenumFromTo :: Fifths -> Fifths -> [Fifths]
enumFromThen :: Fifths -> Fifths -> [Fifths]
$cenumFromThen :: Fifths -> Fifths -> [Fifths]
enumFrom :: Fifths -> [Fifths]
$cenumFrom :: Fifths -> [Fifths]
fromEnum :: Fifths -> Int
$cfromEnum :: Fifths -> Int
toEnum :: Int -> Fifths
$ctoEnum :: Int -> Fifths
pred :: Fifths -> Fifths
$cpred :: Fifths -> Fifths
succ :: Fifths -> Fifths
$csucc :: Fifths -> Fifths
Enum,Integer -> Fifths
Fifths -> Fifths
Fifths -> Fifths -> Fifths
(Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths)
-> (Fifths -> Fifths)
-> (Fifths -> Fifths)
-> (Integer -> Fifths)
-> Num Fifths
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Fifths
$cfromInteger :: Integer -> Fifths
signum :: Fifths -> Fifths
$csignum :: Fifths -> Fifths
abs :: Fifths -> Fifths
$cabs :: Fifths -> Fifths
negate :: Fifths -> Fifths
$cnegate :: Fifths -> Fifths
* :: Fifths -> Fifths -> Fifths
$c* :: Fifths -> Fifths -> Fifths
- :: Fifths -> Fifths -> Fifths
$c- :: Fifths -> Fifths -> Fifths
+ :: Fifths -> Fifths -> Fifths
$c+ :: Fifths -> Fifths -> Fifths
Num,Num Fifths
Ord Fifths
Num Fifths -> Ord Fifths -> (Fifths -> Rational) -> Real Fifths
Fifths -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Fifths -> Rational
$ctoRational :: Fifths -> Rational
$cp2Real :: Ord Fifths
$cp1Real :: Num Fifths
Real,Enum Fifths
Real Fifths
Real Fifths
-> Enum Fifths
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> Fifths)
-> (Fifths -> Fifths -> (Fifths, Fifths))
-> (Fifths -> Fifths -> (Fifths, Fifths))
-> (Fifths -> Integer)
-> Integral Fifths
Fifths -> Integer
Fifths -> Fifths -> (Fifths, Fifths)
Fifths -> Fifths -> Fifths
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Fifths -> Integer
$ctoInteger :: Fifths -> Integer
divMod :: Fifths -> Fifths -> (Fifths, Fifths)
$cdivMod :: Fifths -> Fifths -> (Fifths, Fifths)
quotRem :: Fifths -> Fifths -> (Fifths, Fifths)
$cquotRem :: Fifths -> Fifths -> (Fifths, Fifths)
mod :: Fifths -> Fifths -> Fifths
$cmod :: Fifths -> Fifths -> Fifths
div :: Fifths -> Fifths -> Fifths
$cdiv :: Fifths -> Fifths -> Fifths
rem :: Fifths -> Fifths -> Fifths
$crem :: Fifths -> Fifths -> Fifths
quot :: Fifths -> Fifths -> Fifths
$cquot :: Fifths -> Fifths -> Fifths
$cp2Integral :: Enum Fifths
$cp1Integral :: Real Fifths
Integral)
instance Show Fifths where show :: Fifths -> String
show (Fifths Int
a) = Int -> String
forall a. Show a => a -> String
show Int
a
instance Read Fifths where readsPrec :: Int -> ReadS Fifths
readsPrec Int
i = ((Int, String) -> (Fifths, String))
-> [(Int, String)] -> [(Fifths, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Fifths) -> (Int, String) -> (Fifths, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Int -> Fifths
Fifths) ([(Int, String)] -> [(Fifths, String)])
-> (String -> [(Int, String)]) -> ReadS Fifths
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Fifths where
    emitXml :: Fifths -> XmlRep
emitXml = Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Int -> XmlRep) -> (Fifths -> Int) -> Fifths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fifths -> Int
fifths
parseFifths :: String -> P.XParse Fifths
parseFifths :: String -> XParse Fifths
parseFifths = String -> String -> XParse Fifths
forall a. Read a => String -> String -> XParse a
P.xread String
"Fifths"

-- | @font-size@ /(simple)/
--
-- The font-size can be one of the CSS font sizes or a numeric point size.
data FontSize = 
      FontSizeDecimal {
          FontSize -> Decimal
fontSize1 :: Decimal
       }
    | FontSizeCssFontSize {
          FontSize -> CssFontSize
fontSize2 :: CssFontSize
       }
    deriving (FontSize -> FontSize -> Bool
(FontSize -> FontSize -> Bool)
-> (FontSize -> FontSize -> Bool) -> Eq FontSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSize -> FontSize -> Bool
$c/= :: FontSize -> FontSize -> Bool
== :: FontSize -> FontSize -> Bool
$c== :: FontSize -> FontSize -> Bool
Eq,Typeable,(forall x. FontSize -> Rep FontSize x)
-> (forall x. Rep FontSize x -> FontSize) -> Generic FontSize
forall x. Rep FontSize x -> FontSize
forall x. FontSize -> Rep FontSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontSize x -> FontSize
$cfrom :: forall x. FontSize -> Rep FontSize x
Generic,Int -> FontSize -> ShowS
[FontSize] -> ShowS
FontSize -> String
(Int -> FontSize -> ShowS)
-> (FontSize -> String) -> ([FontSize] -> ShowS) -> Show FontSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSize] -> ShowS
$cshowList :: [FontSize] -> ShowS
show :: FontSize -> String
$cshow :: FontSize -> String
showsPrec :: Int -> FontSize -> ShowS
$cshowsPrec :: Int -> FontSize -> ShowS
Show)
instance EmitXml FontSize where
    emitXml :: FontSize -> XmlRep
emitXml (FontSizeDecimal Decimal
a) = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Decimal
a
    emitXml (FontSizeCssFontSize CssFontSize
a) = CssFontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CssFontSize
a
parseFontSize :: String -> P.XParse FontSize
parseFontSize :: String -> XParse FontSize
parseFontSize String
s = 
      Decimal -> FontSize
FontSizeDecimal
        (Decimal -> FontSize) -> XParse Decimal -> XParse FontSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> XParse Decimal
forall a. Read a => String -> String -> XParse a
P.xread String
"Decimal") String
s
      XParse FontSize -> XParse FontSize -> XParse FontSize
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CssFontSize -> FontSize
FontSizeCssFontSize
        (CssFontSize -> FontSize) -> XParse CssFontSize -> XParse FontSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse CssFontSize
parseCssFontSize String
s


-- | @font-style@ /(simple)/
--
-- The font-style type represents a simplified version of the CSS font-style property.
data FontStyle = 
      FontStyleNormal -- ^ /normal/
    | FontStyleItalic -- ^ /italic/
    deriving (FontStyle -> FontStyle -> Bool
(FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool) -> Eq FontStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStyle -> FontStyle -> Bool
$c/= :: FontStyle -> FontStyle -> Bool
== :: FontStyle -> FontStyle -> Bool
$c== :: FontStyle -> FontStyle -> Bool
Eq,Typeable,(forall x. FontStyle -> Rep FontStyle x)
-> (forall x. Rep FontStyle x -> FontStyle) -> Generic FontStyle
forall x. Rep FontStyle x -> FontStyle
forall x. FontStyle -> Rep FontStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontStyle x -> FontStyle
$cfrom :: forall x. FontStyle -> Rep FontStyle x
Generic,Int -> FontStyle -> ShowS
[FontStyle] -> ShowS
FontStyle -> String
(Int -> FontStyle -> ShowS)
-> (FontStyle -> String)
-> ([FontStyle] -> ShowS)
-> Show FontStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontStyle] -> ShowS
$cshowList :: [FontStyle] -> ShowS
show :: FontStyle -> String
$cshow :: FontStyle -> String
showsPrec :: Int -> FontStyle -> ShowS
$cshowsPrec :: Int -> FontStyle -> ShowS
Show,Eq FontStyle
Eq FontStyle
-> (FontStyle -> FontStyle -> Ordering)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> FontStyle)
-> (FontStyle -> FontStyle -> FontStyle)
-> Ord FontStyle
FontStyle -> FontStyle -> Bool
FontStyle -> FontStyle -> Ordering
FontStyle -> FontStyle -> FontStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontStyle -> FontStyle -> FontStyle
$cmin :: FontStyle -> FontStyle -> FontStyle
max :: FontStyle -> FontStyle -> FontStyle
$cmax :: FontStyle -> FontStyle -> FontStyle
>= :: FontStyle -> FontStyle -> Bool
$c>= :: FontStyle -> FontStyle -> Bool
> :: FontStyle -> FontStyle -> Bool
$c> :: FontStyle -> FontStyle -> Bool
<= :: FontStyle -> FontStyle -> Bool
$c<= :: FontStyle -> FontStyle -> Bool
< :: FontStyle -> FontStyle -> Bool
$c< :: FontStyle -> FontStyle -> Bool
compare :: FontStyle -> FontStyle -> Ordering
$ccompare :: FontStyle -> FontStyle -> Ordering
$cp1Ord :: Eq FontStyle
Ord,Int -> FontStyle
FontStyle -> Int
FontStyle -> [FontStyle]
FontStyle -> FontStyle
FontStyle -> FontStyle -> [FontStyle]
FontStyle -> FontStyle -> FontStyle -> [FontStyle]
(FontStyle -> FontStyle)
-> (FontStyle -> FontStyle)
-> (Int -> FontStyle)
-> (FontStyle -> Int)
-> (FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> FontStyle -> [FontStyle])
-> Enum FontStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
$cenumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromTo :: FontStyle -> FontStyle -> [FontStyle]
enumFromThen :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromThen :: FontStyle -> FontStyle -> [FontStyle]
enumFrom :: FontStyle -> [FontStyle]
$cenumFrom :: FontStyle -> [FontStyle]
fromEnum :: FontStyle -> Int
$cfromEnum :: FontStyle -> Int
toEnum :: Int -> FontStyle
$ctoEnum :: Int -> FontStyle
pred :: FontStyle -> FontStyle
$cpred :: FontStyle -> FontStyle
succ :: FontStyle -> FontStyle
$csucc :: FontStyle -> FontStyle
Enum,FontStyle
FontStyle -> FontStyle -> Bounded FontStyle
forall a. a -> a -> Bounded a
maxBound :: FontStyle
$cmaxBound :: FontStyle
minBound :: FontStyle
$cminBound :: FontStyle
Bounded)
instance EmitXml FontStyle where
    emitXml :: FontStyle -> XmlRep
emitXml FontStyle
FontStyleNormal = String -> XmlRep
XLit String
"normal"
    emitXml FontStyle
FontStyleItalic = String -> XmlRep
XLit String
"italic"
parseFontStyle :: String -> P.XParse FontStyle
parseFontStyle :: String -> XParse FontStyle
parseFontStyle String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = FontStyle -> XParse FontStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (FontStyle -> XParse FontStyle) -> FontStyle -> XParse FontStyle
forall a b. (a -> b) -> a -> b
$ FontStyle
FontStyleNormal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"italic" = FontStyle -> XParse FontStyle
forall (m :: * -> *) a. Monad m => a -> m a
return (FontStyle -> XParse FontStyle) -> FontStyle -> XParse FontStyle
forall a b. (a -> b) -> a -> b
$ FontStyle
FontStyleItalic
        | Bool
otherwise = String -> XParse FontStyle
forall a. String -> XParse a
P.xfail (String -> XParse FontStyle) -> String -> XParse FontStyle
forall a b. (a -> b) -> a -> b
$ String
"FontStyle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @font-weight@ /(simple)/
--
-- The font-weight type represents a simplified version of the CSS font-weight property.
data FontWeight = 
      FontWeightNormal -- ^ /normal/
    | FontWeightBold -- ^ /bold/
    deriving (FontWeight -> FontWeight -> Bool
(FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool) -> Eq FontWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontWeight -> FontWeight -> Bool
$c/= :: FontWeight -> FontWeight -> Bool
== :: FontWeight -> FontWeight -> Bool
$c== :: FontWeight -> FontWeight -> Bool
Eq,Typeable,(forall x. FontWeight -> Rep FontWeight x)
-> (forall x. Rep FontWeight x -> FontWeight) -> Generic FontWeight
forall x. Rep FontWeight x -> FontWeight
forall x. FontWeight -> Rep FontWeight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontWeight x -> FontWeight
$cfrom :: forall x. FontWeight -> Rep FontWeight x
Generic,Int -> FontWeight -> ShowS
[FontWeight] -> ShowS
FontWeight -> String
(Int -> FontWeight -> ShowS)
-> (FontWeight -> String)
-> ([FontWeight] -> ShowS)
-> Show FontWeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontWeight] -> ShowS
$cshowList :: [FontWeight] -> ShowS
show :: FontWeight -> String
$cshow :: FontWeight -> String
showsPrec :: Int -> FontWeight -> ShowS
$cshowsPrec :: Int -> FontWeight -> ShowS
Show,Eq FontWeight
Eq FontWeight
-> (FontWeight -> FontWeight -> Ordering)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> FontWeight)
-> (FontWeight -> FontWeight -> FontWeight)
-> Ord FontWeight
FontWeight -> FontWeight -> Bool
FontWeight -> FontWeight -> Ordering
FontWeight -> FontWeight -> FontWeight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontWeight -> FontWeight -> FontWeight
$cmin :: FontWeight -> FontWeight -> FontWeight
max :: FontWeight -> FontWeight -> FontWeight
$cmax :: FontWeight -> FontWeight -> FontWeight
>= :: FontWeight -> FontWeight -> Bool
$c>= :: FontWeight -> FontWeight -> Bool
> :: FontWeight -> FontWeight -> Bool
$c> :: FontWeight -> FontWeight -> Bool
<= :: FontWeight -> FontWeight -> Bool
$c<= :: FontWeight -> FontWeight -> Bool
< :: FontWeight -> FontWeight -> Bool
$c< :: FontWeight -> FontWeight -> Bool
compare :: FontWeight -> FontWeight -> Ordering
$ccompare :: FontWeight -> FontWeight -> Ordering
$cp1Ord :: Eq FontWeight
Ord,Int -> FontWeight
FontWeight -> Int
FontWeight -> [FontWeight]
FontWeight -> FontWeight
FontWeight -> FontWeight -> [FontWeight]
FontWeight -> FontWeight -> FontWeight -> [FontWeight]
(FontWeight -> FontWeight)
-> (FontWeight -> FontWeight)
-> (Int -> FontWeight)
-> (FontWeight -> Int)
-> (FontWeight -> [FontWeight])
-> (FontWeight -> FontWeight -> [FontWeight])
-> (FontWeight -> FontWeight -> [FontWeight])
-> (FontWeight -> FontWeight -> FontWeight -> [FontWeight])
-> Enum FontWeight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontWeight -> FontWeight -> FontWeight -> [FontWeight]
$cenumFromThenTo :: FontWeight -> FontWeight -> FontWeight -> [FontWeight]
enumFromTo :: FontWeight -> FontWeight -> [FontWeight]
$cenumFromTo :: FontWeight -> FontWeight -> [FontWeight]
enumFromThen :: FontWeight -> FontWeight -> [FontWeight]
$cenumFromThen :: FontWeight -> FontWeight -> [FontWeight]
enumFrom :: FontWeight -> [FontWeight]
$cenumFrom :: FontWeight -> [FontWeight]
fromEnum :: FontWeight -> Int
$cfromEnum :: FontWeight -> Int
toEnum :: Int -> FontWeight
$ctoEnum :: Int -> FontWeight
pred :: FontWeight -> FontWeight
$cpred :: FontWeight -> FontWeight
succ :: FontWeight -> FontWeight
$csucc :: FontWeight -> FontWeight
Enum,FontWeight
FontWeight -> FontWeight -> Bounded FontWeight
forall a. a -> a -> Bounded a
maxBound :: FontWeight
$cmaxBound :: FontWeight
minBound :: FontWeight
$cminBound :: FontWeight
Bounded)
instance EmitXml FontWeight where
    emitXml :: FontWeight -> XmlRep
emitXml FontWeight
FontWeightNormal = String -> XmlRep
XLit String
"normal"
    emitXml FontWeight
FontWeightBold = String -> XmlRep
XLit String
"bold"
parseFontWeight :: String -> P.XParse FontWeight
parseFontWeight :: String -> XParse FontWeight
parseFontWeight String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = FontWeight -> XParse FontWeight
forall (m :: * -> *) a. Monad m => a -> m a
return (FontWeight -> XParse FontWeight)
-> FontWeight -> XParse FontWeight
forall a b. (a -> b) -> a -> b
$ FontWeight
FontWeightNormal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bold" = FontWeight -> XParse FontWeight
forall (m :: * -> *) a. Monad m => a -> m a
return (FontWeight -> XParse FontWeight)
-> FontWeight -> XParse FontWeight
forall a b. (a -> b) -> a -> b
$ FontWeight
FontWeightBold
        | Bool
otherwise = String -> XParse FontWeight
forall a. String -> XParse a
P.xfail (String -> XParse FontWeight) -> String -> XParse FontWeight
forall a b. (a -> b) -> a -> b
$ String
"FontWeight: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @glass-value@ /(simple)/
--
-- The glass-value type represents pictograms for glass percussion instruments.
data GlassValue = 
      GlassValueGlassHarmonica -- ^ /glass harmonica/
    | GlassValueGlassHarp -- ^ /glass harp/
    | GlassValueWindChimes -- ^ /wind chimes/
    deriving (GlassValue -> GlassValue -> Bool
(GlassValue -> GlassValue -> Bool)
-> (GlassValue -> GlassValue -> Bool) -> Eq GlassValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlassValue -> GlassValue -> Bool
$c/= :: GlassValue -> GlassValue -> Bool
== :: GlassValue -> GlassValue -> Bool
$c== :: GlassValue -> GlassValue -> Bool
Eq,Typeable,(forall x. GlassValue -> Rep GlassValue x)
-> (forall x. Rep GlassValue x -> GlassValue) -> Generic GlassValue
forall x. Rep GlassValue x -> GlassValue
forall x. GlassValue -> Rep GlassValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlassValue x -> GlassValue
$cfrom :: forall x. GlassValue -> Rep GlassValue x
Generic,Int -> GlassValue -> ShowS
[GlassValue] -> ShowS
GlassValue -> String
(Int -> GlassValue -> ShowS)
-> (GlassValue -> String)
-> ([GlassValue] -> ShowS)
-> Show GlassValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlassValue] -> ShowS
$cshowList :: [GlassValue] -> ShowS
show :: GlassValue -> String
$cshow :: GlassValue -> String
showsPrec :: Int -> GlassValue -> ShowS
$cshowsPrec :: Int -> GlassValue -> ShowS
Show,Eq GlassValue
Eq GlassValue
-> (GlassValue -> GlassValue -> Ordering)
-> (GlassValue -> GlassValue -> Bool)
-> (GlassValue -> GlassValue -> Bool)
-> (GlassValue -> GlassValue -> Bool)
-> (GlassValue -> GlassValue -> Bool)
-> (GlassValue -> GlassValue -> GlassValue)
-> (GlassValue -> GlassValue -> GlassValue)
-> Ord GlassValue
GlassValue -> GlassValue -> Bool
GlassValue -> GlassValue -> Ordering
GlassValue -> GlassValue -> GlassValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlassValue -> GlassValue -> GlassValue
$cmin :: GlassValue -> GlassValue -> GlassValue
max :: GlassValue -> GlassValue -> GlassValue
$cmax :: GlassValue -> GlassValue -> GlassValue
>= :: GlassValue -> GlassValue -> Bool
$c>= :: GlassValue -> GlassValue -> Bool
> :: GlassValue -> GlassValue -> Bool
$c> :: GlassValue -> GlassValue -> Bool
<= :: GlassValue -> GlassValue -> Bool
$c<= :: GlassValue -> GlassValue -> Bool
< :: GlassValue -> GlassValue -> Bool
$c< :: GlassValue -> GlassValue -> Bool
compare :: GlassValue -> GlassValue -> Ordering
$ccompare :: GlassValue -> GlassValue -> Ordering
$cp1Ord :: Eq GlassValue
Ord,Int -> GlassValue
GlassValue -> Int
GlassValue -> [GlassValue]
GlassValue -> GlassValue
GlassValue -> GlassValue -> [GlassValue]
GlassValue -> GlassValue -> GlassValue -> [GlassValue]
(GlassValue -> GlassValue)
-> (GlassValue -> GlassValue)
-> (Int -> GlassValue)
-> (GlassValue -> Int)
-> (GlassValue -> [GlassValue])
-> (GlassValue -> GlassValue -> [GlassValue])
-> (GlassValue -> GlassValue -> [GlassValue])
-> (GlassValue -> GlassValue -> GlassValue -> [GlassValue])
-> Enum GlassValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GlassValue -> GlassValue -> GlassValue -> [GlassValue]
$cenumFromThenTo :: GlassValue -> GlassValue -> GlassValue -> [GlassValue]
enumFromTo :: GlassValue -> GlassValue -> [GlassValue]
$cenumFromTo :: GlassValue -> GlassValue -> [GlassValue]
enumFromThen :: GlassValue -> GlassValue -> [GlassValue]
$cenumFromThen :: GlassValue -> GlassValue -> [GlassValue]
enumFrom :: GlassValue -> [GlassValue]
$cenumFrom :: GlassValue -> [GlassValue]
fromEnum :: GlassValue -> Int
$cfromEnum :: GlassValue -> Int
toEnum :: Int -> GlassValue
$ctoEnum :: Int -> GlassValue
pred :: GlassValue -> GlassValue
$cpred :: GlassValue -> GlassValue
succ :: GlassValue -> GlassValue
$csucc :: GlassValue -> GlassValue
Enum,GlassValue
GlassValue -> GlassValue -> Bounded GlassValue
forall a. a -> a -> Bounded a
maxBound :: GlassValue
$cmaxBound :: GlassValue
minBound :: GlassValue
$cminBound :: GlassValue
Bounded)
instance EmitXml GlassValue where
    emitXml :: GlassValue -> XmlRep
emitXml GlassValue
GlassValueGlassHarmonica = String -> XmlRep
XLit String
"glass harmonica"
    emitXml GlassValue
GlassValueGlassHarp = String -> XmlRep
XLit String
"glass harp"
    emitXml GlassValue
GlassValueWindChimes = String -> XmlRep
XLit String
"wind chimes"
parseGlassValue :: String -> P.XParse GlassValue
parseGlassValue :: String -> XParse GlassValue
parseGlassValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"glass harmonica" = GlassValue -> XParse GlassValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GlassValue -> XParse GlassValue)
-> GlassValue -> XParse GlassValue
forall a b. (a -> b) -> a -> b
$ GlassValue
GlassValueGlassHarmonica
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"glass harp" = GlassValue -> XParse GlassValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GlassValue -> XParse GlassValue)
-> GlassValue -> XParse GlassValue
forall a b. (a -> b) -> a -> b
$ GlassValue
GlassValueGlassHarp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wind chimes" = GlassValue -> XParse GlassValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GlassValue -> XParse GlassValue)
-> GlassValue -> XParse GlassValue
forall a b. (a -> b) -> a -> b
$ GlassValue
GlassValueWindChimes
        | Bool
otherwise = String -> XParse GlassValue
forall a. String -> XParse a
P.xfail (String -> XParse GlassValue) -> String -> XParse GlassValue
forall a b. (a -> b) -> a -> b
$ String
"GlassValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @glyph-type@ /(simple)/
--
-- The glyph-type defines what type of glyph is being defined in a glyph element. Values include quarter-rest, g-clef-ottava-bassa, c-clef, f-clef, percussion-clef, octave-shift-up-8, octave-shift-down-8, octave-shift-continue-8, octave-shift-down-15, octave-shift-up-15, octave-shift-continue-15, octave-shift-down-22, octave-shift-up-22, and octave-shift-continue-22. This is left as a string so that other application-specific types can be defined, but it is made a separate type so that it can be redefined more strictly.
-- 
-- A quarter-rest type specifies the glyph to use when a note has a rest element and a type value of quarter. The c-clef, f-clef, and percussion-clef types specify the glyph to use when a clef sign element value is C, F, or percussion respectively. The g-clef-ottava-bassa type specifies the glyph to use when a clef sign element value is G and the clef-octave-change element value is -1. The octave-shift types specify the glyph to use when an octave-shift type attribute value is up, down, or continue and the octave-shift size attribute value is 8, 15, or 22.
newtype GlyphType = GlyphType { GlyphType -> Token
glyphType :: Token }
    deriving (GlyphType -> GlyphType -> Bool
(GlyphType -> GlyphType -> Bool)
-> (GlyphType -> GlyphType -> Bool) -> Eq GlyphType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphType -> GlyphType -> Bool
$c/= :: GlyphType -> GlyphType -> Bool
== :: GlyphType -> GlyphType -> Bool
$c== :: GlyphType -> GlyphType -> Bool
Eq,Typeable,(forall x. GlyphType -> Rep GlyphType x)
-> (forall x. Rep GlyphType x -> GlyphType) -> Generic GlyphType
forall x. Rep GlyphType x -> GlyphType
forall x. GlyphType -> Rep GlyphType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphType x -> GlyphType
$cfrom :: forall x. GlyphType -> Rep GlyphType x
Generic,Eq GlyphType
Eq GlyphType
-> (GlyphType -> GlyphType -> Ordering)
-> (GlyphType -> GlyphType -> Bool)
-> (GlyphType -> GlyphType -> Bool)
-> (GlyphType -> GlyphType -> Bool)
-> (GlyphType -> GlyphType -> Bool)
-> (GlyphType -> GlyphType -> GlyphType)
-> (GlyphType -> GlyphType -> GlyphType)
-> Ord GlyphType
GlyphType -> GlyphType -> Bool
GlyphType -> GlyphType -> Ordering
GlyphType -> GlyphType -> GlyphType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GlyphType -> GlyphType -> GlyphType
$cmin :: GlyphType -> GlyphType -> GlyphType
max :: GlyphType -> GlyphType -> GlyphType
$cmax :: GlyphType -> GlyphType -> GlyphType
>= :: GlyphType -> GlyphType -> Bool
$c>= :: GlyphType -> GlyphType -> Bool
> :: GlyphType -> GlyphType -> Bool
$c> :: GlyphType -> GlyphType -> Bool
<= :: GlyphType -> GlyphType -> Bool
$c<= :: GlyphType -> GlyphType -> Bool
< :: GlyphType -> GlyphType -> Bool
$c< :: GlyphType -> GlyphType -> Bool
compare :: GlyphType -> GlyphType -> Ordering
$ccompare :: GlyphType -> GlyphType -> Ordering
$cp1Ord :: Eq GlyphType
Ord,String -> GlyphType
(String -> GlyphType) -> IsString GlyphType
forall a. (String -> a) -> IsString a
fromString :: String -> GlyphType
$cfromString :: String -> GlyphType
IsString)
instance Show GlyphType where show :: GlyphType -> String
show (GlyphType Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read GlyphType where readsPrec :: Int -> ReadS GlyphType
readsPrec Int
i = ((Token, String) -> (GlyphType, String))
-> [(Token, String)] -> [(GlyphType, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> GlyphType) -> (Token, String) -> (GlyphType, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> GlyphType
GlyphType) ([(Token, String)] -> [(GlyphType, String)])
-> (String -> [(Token, String)]) -> ReadS GlyphType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml GlyphType where
    emitXml :: GlyphType -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (GlyphType -> Token) -> GlyphType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphType -> Token
glyphType
parseGlyphType :: String -> P.XParse GlyphType
parseGlyphType :: String -> XParse GlyphType
parseGlyphType = GlyphType -> XParse GlyphType
forall (m :: * -> *) a. Monad m => a -> m a
return (GlyphType -> XParse GlyphType)
-> (String -> GlyphType) -> String -> XParse GlyphType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GlyphType
forall a. IsString a => String -> a
fromString

-- | @group-barline-value@ /(simple)/
--
-- The group-barline-value type indicates if the group should have common barlines.
data GroupBarlineValue = 
      GroupBarlineValueYes -- ^ /yes/
    | GroupBarlineValueNo -- ^ /no/
    | GroupBarlineValueMensurstrich -- ^ /Mensurstrich/
    deriving (GroupBarlineValue -> GroupBarlineValue -> Bool
(GroupBarlineValue -> GroupBarlineValue -> Bool)
-> (GroupBarlineValue -> GroupBarlineValue -> Bool)
-> Eq GroupBarlineValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c/= :: GroupBarlineValue -> GroupBarlineValue -> Bool
== :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c== :: GroupBarlineValue -> GroupBarlineValue -> Bool
Eq,Typeable,(forall x. GroupBarlineValue -> Rep GroupBarlineValue x)
-> (forall x. Rep GroupBarlineValue x -> GroupBarlineValue)
-> Generic GroupBarlineValue
forall x. Rep GroupBarlineValue x -> GroupBarlineValue
forall x. GroupBarlineValue -> Rep GroupBarlineValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupBarlineValue x -> GroupBarlineValue
$cfrom :: forall x. GroupBarlineValue -> Rep GroupBarlineValue x
Generic,Int -> GroupBarlineValue -> ShowS
[GroupBarlineValue] -> ShowS
GroupBarlineValue -> String
(Int -> GroupBarlineValue -> ShowS)
-> (GroupBarlineValue -> String)
-> ([GroupBarlineValue] -> ShowS)
-> Show GroupBarlineValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupBarlineValue] -> ShowS
$cshowList :: [GroupBarlineValue] -> ShowS
show :: GroupBarlineValue -> String
$cshow :: GroupBarlineValue -> String
showsPrec :: Int -> GroupBarlineValue -> ShowS
$cshowsPrec :: Int -> GroupBarlineValue -> ShowS
Show,Eq GroupBarlineValue
Eq GroupBarlineValue
-> (GroupBarlineValue -> GroupBarlineValue -> Ordering)
-> (GroupBarlineValue -> GroupBarlineValue -> Bool)
-> (GroupBarlineValue -> GroupBarlineValue -> Bool)
-> (GroupBarlineValue -> GroupBarlineValue -> Bool)
-> (GroupBarlineValue -> GroupBarlineValue -> Bool)
-> (GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue)
-> (GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue)
-> Ord GroupBarlineValue
GroupBarlineValue -> GroupBarlineValue -> Bool
GroupBarlineValue -> GroupBarlineValue -> Ordering
GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue
$cmin :: GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue
max :: GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue
$cmax :: GroupBarlineValue -> GroupBarlineValue -> GroupBarlineValue
>= :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c>= :: GroupBarlineValue -> GroupBarlineValue -> Bool
> :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c> :: GroupBarlineValue -> GroupBarlineValue -> Bool
<= :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c<= :: GroupBarlineValue -> GroupBarlineValue -> Bool
< :: GroupBarlineValue -> GroupBarlineValue -> Bool
$c< :: GroupBarlineValue -> GroupBarlineValue -> Bool
compare :: GroupBarlineValue -> GroupBarlineValue -> Ordering
$ccompare :: GroupBarlineValue -> GroupBarlineValue -> Ordering
$cp1Ord :: Eq GroupBarlineValue
Ord,Int -> GroupBarlineValue
GroupBarlineValue -> Int
GroupBarlineValue -> [GroupBarlineValue]
GroupBarlineValue -> GroupBarlineValue
GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
GroupBarlineValue
-> GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
(GroupBarlineValue -> GroupBarlineValue)
-> (GroupBarlineValue -> GroupBarlineValue)
-> (Int -> GroupBarlineValue)
-> (GroupBarlineValue -> Int)
-> (GroupBarlineValue -> [GroupBarlineValue])
-> (GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue])
-> (GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue])
-> (GroupBarlineValue
    -> GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue])
-> Enum GroupBarlineValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GroupBarlineValue
-> GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
$cenumFromThenTo :: GroupBarlineValue
-> GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
enumFromTo :: GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
$cenumFromTo :: GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
enumFromThen :: GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
$cenumFromThen :: GroupBarlineValue -> GroupBarlineValue -> [GroupBarlineValue]
enumFrom :: GroupBarlineValue -> [GroupBarlineValue]
$cenumFrom :: GroupBarlineValue -> [GroupBarlineValue]
fromEnum :: GroupBarlineValue -> Int
$cfromEnum :: GroupBarlineValue -> Int
toEnum :: Int -> GroupBarlineValue
$ctoEnum :: Int -> GroupBarlineValue
pred :: GroupBarlineValue -> GroupBarlineValue
$cpred :: GroupBarlineValue -> GroupBarlineValue
succ :: GroupBarlineValue -> GroupBarlineValue
$csucc :: GroupBarlineValue -> GroupBarlineValue
Enum,GroupBarlineValue
GroupBarlineValue -> GroupBarlineValue -> Bounded GroupBarlineValue
forall a. a -> a -> Bounded a
maxBound :: GroupBarlineValue
$cmaxBound :: GroupBarlineValue
minBound :: GroupBarlineValue
$cminBound :: GroupBarlineValue
Bounded)
instance EmitXml GroupBarlineValue where
    emitXml :: GroupBarlineValue -> XmlRep
emitXml GroupBarlineValue
GroupBarlineValueYes = String -> XmlRep
XLit String
"yes"
    emitXml GroupBarlineValue
GroupBarlineValueNo = String -> XmlRep
XLit String
"no"
    emitXml GroupBarlineValue
GroupBarlineValueMensurstrich = String -> XmlRep
XLit String
"Mensurstrich"
parseGroupBarlineValue :: String -> P.XParse GroupBarlineValue
parseGroupBarlineValue :: String -> XParse GroupBarlineValue
parseGroupBarlineValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yes" = GroupBarlineValue -> XParse GroupBarlineValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupBarlineValue -> XParse GroupBarlineValue)
-> GroupBarlineValue -> XParse GroupBarlineValue
forall a b. (a -> b) -> a -> b
$ GroupBarlineValue
GroupBarlineValueYes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"no" = GroupBarlineValue -> XParse GroupBarlineValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupBarlineValue -> XParse GroupBarlineValue)
-> GroupBarlineValue -> XParse GroupBarlineValue
forall a b. (a -> b) -> a -> b
$ GroupBarlineValue
GroupBarlineValueNo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Mensurstrich" = GroupBarlineValue -> XParse GroupBarlineValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupBarlineValue -> XParse GroupBarlineValue)
-> GroupBarlineValue -> XParse GroupBarlineValue
forall a b. (a -> b) -> a -> b
$ GroupBarlineValue
GroupBarlineValueMensurstrich
        | Bool
otherwise = String -> XParse GroupBarlineValue
forall a. String -> XParse a
P.xfail (String -> XParse GroupBarlineValue)
-> String -> XParse GroupBarlineValue
forall a b. (a -> b) -> a -> b
$ String
"GroupBarlineValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @group-symbol-value@ /(simple)/
--
-- The group-symbol-value type indicates how the symbol for a group is indicated in the score. The default value is none.
data GroupSymbolValue = 
      GroupSymbolValueNone -- ^ /none/
    | GroupSymbolValueBrace -- ^ /brace/
    | GroupSymbolValueLine -- ^ /line/
    | GroupSymbolValueBracket -- ^ /bracket/
    | GroupSymbolValueSquare -- ^ /square/
    deriving (GroupSymbolValue -> GroupSymbolValue -> Bool
(GroupSymbolValue -> GroupSymbolValue -> Bool)
-> (GroupSymbolValue -> GroupSymbolValue -> Bool)
-> Eq GroupSymbolValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c/= :: GroupSymbolValue -> GroupSymbolValue -> Bool
== :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c== :: GroupSymbolValue -> GroupSymbolValue -> Bool
Eq,Typeable,(forall x. GroupSymbolValue -> Rep GroupSymbolValue x)
-> (forall x. Rep GroupSymbolValue x -> GroupSymbolValue)
-> Generic GroupSymbolValue
forall x. Rep GroupSymbolValue x -> GroupSymbolValue
forall x. GroupSymbolValue -> Rep GroupSymbolValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupSymbolValue x -> GroupSymbolValue
$cfrom :: forall x. GroupSymbolValue -> Rep GroupSymbolValue x
Generic,Int -> GroupSymbolValue -> ShowS
[GroupSymbolValue] -> ShowS
GroupSymbolValue -> String
(Int -> GroupSymbolValue -> ShowS)
-> (GroupSymbolValue -> String)
-> ([GroupSymbolValue] -> ShowS)
-> Show GroupSymbolValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupSymbolValue] -> ShowS
$cshowList :: [GroupSymbolValue] -> ShowS
show :: GroupSymbolValue -> String
$cshow :: GroupSymbolValue -> String
showsPrec :: Int -> GroupSymbolValue -> ShowS
$cshowsPrec :: Int -> GroupSymbolValue -> ShowS
Show,Eq GroupSymbolValue
Eq GroupSymbolValue
-> (GroupSymbolValue -> GroupSymbolValue -> Ordering)
-> (GroupSymbolValue -> GroupSymbolValue -> Bool)
-> (GroupSymbolValue -> GroupSymbolValue -> Bool)
-> (GroupSymbolValue -> GroupSymbolValue -> Bool)
-> (GroupSymbolValue -> GroupSymbolValue -> Bool)
-> (GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue)
-> (GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue)
-> Ord GroupSymbolValue
GroupSymbolValue -> GroupSymbolValue -> Bool
GroupSymbolValue -> GroupSymbolValue -> Ordering
GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue
$cmin :: GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue
max :: GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue
$cmax :: GroupSymbolValue -> GroupSymbolValue -> GroupSymbolValue
>= :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c>= :: GroupSymbolValue -> GroupSymbolValue -> Bool
> :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c> :: GroupSymbolValue -> GroupSymbolValue -> Bool
<= :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c<= :: GroupSymbolValue -> GroupSymbolValue -> Bool
< :: GroupSymbolValue -> GroupSymbolValue -> Bool
$c< :: GroupSymbolValue -> GroupSymbolValue -> Bool
compare :: GroupSymbolValue -> GroupSymbolValue -> Ordering
$ccompare :: GroupSymbolValue -> GroupSymbolValue -> Ordering
$cp1Ord :: Eq GroupSymbolValue
Ord,Int -> GroupSymbolValue
GroupSymbolValue -> Int
GroupSymbolValue -> [GroupSymbolValue]
GroupSymbolValue -> GroupSymbolValue
GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
GroupSymbolValue
-> GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
(GroupSymbolValue -> GroupSymbolValue)
-> (GroupSymbolValue -> GroupSymbolValue)
-> (Int -> GroupSymbolValue)
-> (GroupSymbolValue -> Int)
-> (GroupSymbolValue -> [GroupSymbolValue])
-> (GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue])
-> (GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue])
-> (GroupSymbolValue
    -> GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue])
-> Enum GroupSymbolValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GroupSymbolValue
-> GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
$cenumFromThenTo :: GroupSymbolValue
-> GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
enumFromTo :: GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
$cenumFromTo :: GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
enumFromThen :: GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
$cenumFromThen :: GroupSymbolValue -> GroupSymbolValue -> [GroupSymbolValue]
enumFrom :: GroupSymbolValue -> [GroupSymbolValue]
$cenumFrom :: GroupSymbolValue -> [GroupSymbolValue]
fromEnum :: GroupSymbolValue -> Int
$cfromEnum :: GroupSymbolValue -> Int
toEnum :: Int -> GroupSymbolValue
$ctoEnum :: Int -> GroupSymbolValue
pred :: GroupSymbolValue -> GroupSymbolValue
$cpred :: GroupSymbolValue -> GroupSymbolValue
succ :: GroupSymbolValue -> GroupSymbolValue
$csucc :: GroupSymbolValue -> GroupSymbolValue
Enum,GroupSymbolValue
GroupSymbolValue -> GroupSymbolValue -> Bounded GroupSymbolValue
forall a. a -> a -> Bounded a
maxBound :: GroupSymbolValue
$cmaxBound :: GroupSymbolValue
minBound :: GroupSymbolValue
$cminBound :: GroupSymbolValue
Bounded)
instance EmitXml GroupSymbolValue where
    emitXml :: GroupSymbolValue -> XmlRep
emitXml GroupSymbolValue
GroupSymbolValueNone = String -> XmlRep
XLit String
"none"
    emitXml GroupSymbolValue
GroupSymbolValueBrace = String -> XmlRep
XLit String
"brace"
    emitXml GroupSymbolValue
GroupSymbolValueLine = String -> XmlRep
XLit String
"line"
    emitXml GroupSymbolValue
GroupSymbolValueBracket = String -> XmlRep
XLit String
"bracket"
    emitXml GroupSymbolValue
GroupSymbolValueSquare = String -> XmlRep
XLit String
"square"
parseGroupSymbolValue :: String -> P.XParse GroupSymbolValue
parseGroupSymbolValue :: String -> XParse GroupSymbolValue
parseGroupSymbolValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = GroupSymbolValue -> XParse GroupSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupSymbolValue -> XParse GroupSymbolValue)
-> GroupSymbolValue -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ GroupSymbolValue
GroupSymbolValueNone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"brace" = GroupSymbolValue -> XParse GroupSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupSymbolValue -> XParse GroupSymbolValue)
-> GroupSymbolValue -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ GroupSymbolValue
GroupSymbolValueBrace
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"line" = GroupSymbolValue -> XParse GroupSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupSymbolValue -> XParse GroupSymbolValue)
-> GroupSymbolValue -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ GroupSymbolValue
GroupSymbolValueLine
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bracket" = GroupSymbolValue -> XParse GroupSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupSymbolValue -> XParse GroupSymbolValue)
-> GroupSymbolValue -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ GroupSymbolValue
GroupSymbolValueBracket
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"square" = GroupSymbolValue -> XParse GroupSymbolValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GroupSymbolValue -> XParse GroupSymbolValue)
-> GroupSymbolValue -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ GroupSymbolValue
GroupSymbolValueSquare
        | Bool
otherwise = String -> XParse GroupSymbolValue
forall a. String -> XParse a
P.xfail (String -> XParse GroupSymbolValue)
-> String -> XParse GroupSymbolValue
forall a b. (a -> b) -> a -> b
$ String
"GroupSymbolValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @handbell-value@ /(simple)/
--
-- The handbell-value type represents the type of handbell technique being notated.
data HandbellValue = 
      HandbellValueBelltree -- ^ /belltree/
    | HandbellValueDamp -- ^ /damp/
    | HandbellValueEcho -- ^ /echo/
    | HandbellValueGyro -- ^ /gyro/
    | HandbellValueHandMartellato -- ^ /hand martellato/
    | HandbellValueMalletLift -- ^ /mallet lift/
    | HandbellValueMalletTable -- ^ /mallet table/
    | HandbellValueMartellato -- ^ /martellato/
    | HandbellValueMartellatoLift -- ^ /martellato lift/
    | HandbellValueMutedMartellato -- ^ /muted martellato/
    | HandbellValuePluckLift -- ^ /pluck lift/
    | HandbellValueSwing -- ^ /swing/
    deriving (HandbellValue -> HandbellValue -> Bool
(HandbellValue -> HandbellValue -> Bool)
-> (HandbellValue -> HandbellValue -> Bool) -> Eq HandbellValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandbellValue -> HandbellValue -> Bool
$c/= :: HandbellValue -> HandbellValue -> Bool
== :: HandbellValue -> HandbellValue -> Bool
$c== :: HandbellValue -> HandbellValue -> Bool
Eq,Typeable,(forall x. HandbellValue -> Rep HandbellValue x)
-> (forall x. Rep HandbellValue x -> HandbellValue)
-> Generic HandbellValue
forall x. Rep HandbellValue x -> HandbellValue
forall x. HandbellValue -> Rep HandbellValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HandbellValue x -> HandbellValue
$cfrom :: forall x. HandbellValue -> Rep HandbellValue x
Generic,Int -> HandbellValue -> ShowS
[HandbellValue] -> ShowS
HandbellValue -> String
(Int -> HandbellValue -> ShowS)
-> (HandbellValue -> String)
-> ([HandbellValue] -> ShowS)
-> Show HandbellValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandbellValue] -> ShowS
$cshowList :: [HandbellValue] -> ShowS
show :: HandbellValue -> String
$cshow :: HandbellValue -> String
showsPrec :: Int -> HandbellValue -> ShowS
$cshowsPrec :: Int -> HandbellValue -> ShowS
Show,Eq HandbellValue
Eq HandbellValue
-> (HandbellValue -> HandbellValue -> Ordering)
-> (HandbellValue -> HandbellValue -> Bool)
-> (HandbellValue -> HandbellValue -> Bool)
-> (HandbellValue -> HandbellValue -> Bool)
-> (HandbellValue -> HandbellValue -> Bool)
-> (HandbellValue -> HandbellValue -> HandbellValue)
-> (HandbellValue -> HandbellValue -> HandbellValue)
-> Ord HandbellValue
HandbellValue -> HandbellValue -> Bool
HandbellValue -> HandbellValue -> Ordering
HandbellValue -> HandbellValue -> HandbellValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HandbellValue -> HandbellValue -> HandbellValue
$cmin :: HandbellValue -> HandbellValue -> HandbellValue
max :: HandbellValue -> HandbellValue -> HandbellValue
$cmax :: HandbellValue -> HandbellValue -> HandbellValue
>= :: HandbellValue -> HandbellValue -> Bool
$c>= :: HandbellValue -> HandbellValue -> Bool
> :: HandbellValue -> HandbellValue -> Bool
$c> :: HandbellValue -> HandbellValue -> Bool
<= :: HandbellValue -> HandbellValue -> Bool
$c<= :: HandbellValue -> HandbellValue -> Bool
< :: HandbellValue -> HandbellValue -> Bool
$c< :: HandbellValue -> HandbellValue -> Bool
compare :: HandbellValue -> HandbellValue -> Ordering
$ccompare :: HandbellValue -> HandbellValue -> Ordering
$cp1Ord :: Eq HandbellValue
Ord,Int -> HandbellValue
HandbellValue -> Int
HandbellValue -> [HandbellValue]
HandbellValue -> HandbellValue
HandbellValue -> HandbellValue -> [HandbellValue]
HandbellValue -> HandbellValue -> HandbellValue -> [HandbellValue]
(HandbellValue -> HandbellValue)
-> (HandbellValue -> HandbellValue)
-> (Int -> HandbellValue)
-> (HandbellValue -> Int)
-> (HandbellValue -> [HandbellValue])
-> (HandbellValue -> HandbellValue -> [HandbellValue])
-> (HandbellValue -> HandbellValue -> [HandbellValue])
-> (HandbellValue
    -> HandbellValue -> HandbellValue -> [HandbellValue])
-> Enum HandbellValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HandbellValue -> HandbellValue -> HandbellValue -> [HandbellValue]
$cenumFromThenTo :: HandbellValue -> HandbellValue -> HandbellValue -> [HandbellValue]
enumFromTo :: HandbellValue -> HandbellValue -> [HandbellValue]
$cenumFromTo :: HandbellValue -> HandbellValue -> [HandbellValue]
enumFromThen :: HandbellValue -> HandbellValue -> [HandbellValue]
$cenumFromThen :: HandbellValue -> HandbellValue -> [HandbellValue]
enumFrom :: HandbellValue -> [HandbellValue]
$cenumFrom :: HandbellValue -> [HandbellValue]
fromEnum :: HandbellValue -> Int
$cfromEnum :: HandbellValue -> Int
toEnum :: Int -> HandbellValue
$ctoEnum :: Int -> HandbellValue
pred :: HandbellValue -> HandbellValue
$cpred :: HandbellValue -> HandbellValue
succ :: HandbellValue -> HandbellValue
$csucc :: HandbellValue -> HandbellValue
Enum,HandbellValue
HandbellValue -> HandbellValue -> Bounded HandbellValue
forall a. a -> a -> Bounded a
maxBound :: HandbellValue
$cmaxBound :: HandbellValue
minBound :: HandbellValue
$cminBound :: HandbellValue
Bounded)
instance EmitXml HandbellValue where
    emitXml :: HandbellValue -> XmlRep
emitXml HandbellValue
HandbellValueBelltree = String -> XmlRep
XLit String
"belltree"
    emitXml HandbellValue
HandbellValueDamp = String -> XmlRep
XLit String
"damp"
    emitXml HandbellValue
HandbellValueEcho = String -> XmlRep
XLit String
"echo"
    emitXml HandbellValue
HandbellValueGyro = String -> XmlRep
XLit String
"gyro"
    emitXml HandbellValue
HandbellValueHandMartellato = String -> XmlRep
XLit String
"hand martellato"
    emitXml HandbellValue
HandbellValueMalletLift = String -> XmlRep
XLit String
"mallet lift"
    emitXml HandbellValue
HandbellValueMalletTable = String -> XmlRep
XLit String
"mallet table"
    emitXml HandbellValue
HandbellValueMartellato = String -> XmlRep
XLit String
"martellato"
    emitXml HandbellValue
HandbellValueMartellatoLift = String -> XmlRep
XLit String
"martellato lift"
    emitXml HandbellValue
HandbellValueMutedMartellato = String -> XmlRep
XLit String
"muted martellato"
    emitXml HandbellValue
HandbellValuePluckLift = String -> XmlRep
XLit String
"pluck lift"
    emitXml HandbellValue
HandbellValueSwing = String -> XmlRep
XLit String
"swing"
parseHandbellValue :: String -> P.XParse HandbellValue
parseHandbellValue :: String -> XParse HandbellValue
parseHandbellValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"belltree" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueBelltree
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"damp" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueDamp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"echo" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueEcho
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"gyro" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueGyro
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hand martellato" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueHandMartellato
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mallet lift" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueMalletLift
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mallet table" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueMalletTable
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"martellato" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueMartellato
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"martellato lift" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueMartellatoLift
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"muted martellato" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueMutedMartellato
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"pluck lift" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValuePluckLift
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"swing" = HandbellValue -> XParse HandbellValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HandbellValue -> XParse HandbellValue)
-> HandbellValue -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ HandbellValue
HandbellValueSwing
        | Bool
otherwise = String -> XParse HandbellValue
forall a. String -> XParse a
P.xfail (String -> XParse HandbellValue) -> String -> XParse HandbellValue
forall a b. (a -> b) -> a -> b
$ String
"HandbellValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @harmon-closed-location@ /(simple)/
--
-- The harmon-closed-location type indicates which portion of the symbol is filled in when the corresponding harmon-closed-value is half.
data HarmonClosedLocation = 
      HarmonClosedLocationRight -- ^ /right/
    | HarmonClosedLocationBottom -- ^ /bottom/
    | HarmonClosedLocationLeft -- ^ /left/
    | HarmonClosedLocationTop -- ^ /top/
    deriving (HarmonClosedLocation -> HarmonClosedLocation -> Bool
(HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> (HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> Eq HarmonClosedLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c/= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
== :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c== :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
Eq,Typeable,(forall x. HarmonClosedLocation -> Rep HarmonClosedLocation x)
-> (forall x. Rep HarmonClosedLocation x -> HarmonClosedLocation)
-> Generic HarmonClosedLocation
forall x. Rep HarmonClosedLocation x -> HarmonClosedLocation
forall x. HarmonClosedLocation -> Rep HarmonClosedLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonClosedLocation x -> HarmonClosedLocation
$cfrom :: forall x. HarmonClosedLocation -> Rep HarmonClosedLocation x
Generic,Int -> HarmonClosedLocation -> ShowS
[HarmonClosedLocation] -> ShowS
HarmonClosedLocation -> String
(Int -> HarmonClosedLocation -> ShowS)
-> (HarmonClosedLocation -> String)
-> ([HarmonClosedLocation] -> ShowS)
-> Show HarmonClosedLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonClosedLocation] -> ShowS
$cshowList :: [HarmonClosedLocation] -> ShowS
show :: HarmonClosedLocation -> String
$cshow :: HarmonClosedLocation -> String
showsPrec :: Int -> HarmonClosedLocation -> ShowS
$cshowsPrec :: Int -> HarmonClosedLocation -> ShowS
Show,Eq HarmonClosedLocation
Eq HarmonClosedLocation
-> (HarmonClosedLocation -> HarmonClosedLocation -> Ordering)
-> (HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> (HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> (HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> (HarmonClosedLocation -> HarmonClosedLocation -> Bool)
-> (HarmonClosedLocation
    -> HarmonClosedLocation -> HarmonClosedLocation)
-> (HarmonClosedLocation
    -> HarmonClosedLocation -> HarmonClosedLocation)
-> Ord HarmonClosedLocation
HarmonClosedLocation -> HarmonClosedLocation -> Bool
HarmonClosedLocation -> HarmonClosedLocation -> Ordering
HarmonClosedLocation
-> HarmonClosedLocation -> HarmonClosedLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HarmonClosedLocation
-> HarmonClosedLocation -> HarmonClosedLocation
$cmin :: HarmonClosedLocation
-> HarmonClosedLocation -> HarmonClosedLocation
max :: HarmonClosedLocation
-> HarmonClosedLocation -> HarmonClosedLocation
$cmax :: HarmonClosedLocation
-> HarmonClosedLocation -> HarmonClosedLocation
>= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c>= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
> :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c> :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
<= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c<= :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
< :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
$c< :: HarmonClosedLocation -> HarmonClosedLocation -> Bool
compare :: HarmonClosedLocation -> HarmonClosedLocation -> Ordering
$ccompare :: HarmonClosedLocation -> HarmonClosedLocation -> Ordering
$cp1Ord :: Eq HarmonClosedLocation
Ord,Int -> HarmonClosedLocation
HarmonClosedLocation -> Int
HarmonClosedLocation -> [HarmonClosedLocation]
HarmonClosedLocation -> HarmonClosedLocation
HarmonClosedLocation
-> HarmonClosedLocation -> [HarmonClosedLocation]
HarmonClosedLocation
-> HarmonClosedLocation
-> HarmonClosedLocation
-> [HarmonClosedLocation]
(HarmonClosedLocation -> HarmonClosedLocation)
-> (HarmonClosedLocation -> HarmonClosedLocation)
-> (Int -> HarmonClosedLocation)
-> (HarmonClosedLocation -> Int)
-> (HarmonClosedLocation -> [HarmonClosedLocation])
-> (HarmonClosedLocation
    -> HarmonClosedLocation -> [HarmonClosedLocation])
-> (HarmonClosedLocation
    -> HarmonClosedLocation -> [HarmonClosedLocation])
-> (HarmonClosedLocation
    -> HarmonClosedLocation
    -> HarmonClosedLocation
    -> [HarmonClosedLocation])
-> Enum HarmonClosedLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HarmonClosedLocation
-> HarmonClosedLocation
-> HarmonClosedLocation
-> [HarmonClosedLocation]
$cenumFromThenTo :: HarmonClosedLocation
-> HarmonClosedLocation
-> HarmonClosedLocation
-> [HarmonClosedLocation]
enumFromTo :: HarmonClosedLocation
-> HarmonClosedLocation -> [HarmonClosedLocation]
$cenumFromTo :: HarmonClosedLocation
-> HarmonClosedLocation -> [HarmonClosedLocation]
enumFromThen :: HarmonClosedLocation
-> HarmonClosedLocation -> [HarmonClosedLocation]
$cenumFromThen :: HarmonClosedLocation
-> HarmonClosedLocation -> [HarmonClosedLocation]
enumFrom :: HarmonClosedLocation -> [HarmonClosedLocation]
$cenumFrom :: HarmonClosedLocation -> [HarmonClosedLocation]
fromEnum :: HarmonClosedLocation -> Int
$cfromEnum :: HarmonClosedLocation -> Int
toEnum :: Int -> HarmonClosedLocation
$ctoEnum :: Int -> HarmonClosedLocation
pred :: HarmonClosedLocation -> HarmonClosedLocation
$cpred :: HarmonClosedLocation -> HarmonClosedLocation
succ :: HarmonClosedLocation -> HarmonClosedLocation
$csucc :: HarmonClosedLocation -> HarmonClosedLocation
Enum,HarmonClosedLocation
HarmonClosedLocation
-> HarmonClosedLocation -> Bounded HarmonClosedLocation
forall a. a -> a -> Bounded a
maxBound :: HarmonClosedLocation
$cmaxBound :: HarmonClosedLocation
minBound :: HarmonClosedLocation
$cminBound :: HarmonClosedLocation
Bounded)
instance EmitXml HarmonClosedLocation where
    emitXml :: HarmonClosedLocation -> XmlRep
emitXml HarmonClosedLocation
HarmonClosedLocationRight = String -> XmlRep
XLit String
"right"
    emitXml HarmonClosedLocation
HarmonClosedLocationBottom = String -> XmlRep
XLit String
"bottom"
    emitXml HarmonClosedLocation
HarmonClosedLocationLeft = String -> XmlRep
XLit String
"left"
    emitXml HarmonClosedLocation
HarmonClosedLocationTop = String -> XmlRep
XLit String
"top"
parseHarmonClosedLocation :: String -> P.XParse HarmonClosedLocation
parseHarmonClosedLocation :: String -> XParse HarmonClosedLocation
parseHarmonClosedLocation String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = HarmonClosedLocation -> XParse HarmonClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedLocation -> XParse HarmonClosedLocation)
-> HarmonClosedLocation -> XParse HarmonClosedLocation
forall a b. (a -> b) -> a -> b
$ HarmonClosedLocation
HarmonClosedLocationRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bottom" = HarmonClosedLocation -> XParse HarmonClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedLocation -> XParse HarmonClosedLocation)
-> HarmonClosedLocation -> XParse HarmonClosedLocation
forall a b. (a -> b) -> a -> b
$ HarmonClosedLocation
HarmonClosedLocationBottom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = HarmonClosedLocation -> XParse HarmonClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedLocation -> XParse HarmonClosedLocation)
-> HarmonClosedLocation -> XParse HarmonClosedLocation
forall a b. (a -> b) -> a -> b
$ HarmonClosedLocation
HarmonClosedLocationLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"top" = HarmonClosedLocation -> XParse HarmonClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedLocation -> XParse HarmonClosedLocation)
-> HarmonClosedLocation -> XParse HarmonClosedLocation
forall a b. (a -> b) -> a -> b
$ HarmonClosedLocation
HarmonClosedLocationTop
        | Bool
otherwise = String -> XParse HarmonClosedLocation
forall a. String -> XParse a
P.xfail (String -> XParse HarmonClosedLocation)
-> String -> XParse HarmonClosedLocation
forall a b. (a -> b) -> a -> b
$ String
"HarmonClosedLocation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @harmon-closed-value@ /(simple)/
--
-- The harmon-closed-value type represents whether the harmon mute is closed, open, or half-open.
data HarmonClosedValue = 
      HarmonClosedValueYes -- ^ /yes/
    | HarmonClosedValueNo -- ^ /no/
    | HarmonClosedValueHalf -- ^ /half/
    deriving (HarmonClosedValue -> HarmonClosedValue -> Bool
(HarmonClosedValue -> HarmonClosedValue -> Bool)
-> (HarmonClosedValue -> HarmonClosedValue -> Bool)
-> Eq HarmonClosedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c/= :: HarmonClosedValue -> HarmonClosedValue -> Bool
== :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c== :: HarmonClosedValue -> HarmonClosedValue -> Bool
Eq,Typeable,(forall x. HarmonClosedValue -> Rep HarmonClosedValue x)
-> (forall x. Rep HarmonClosedValue x -> HarmonClosedValue)
-> Generic HarmonClosedValue
forall x. Rep HarmonClosedValue x -> HarmonClosedValue
forall x. HarmonClosedValue -> Rep HarmonClosedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonClosedValue x -> HarmonClosedValue
$cfrom :: forall x. HarmonClosedValue -> Rep HarmonClosedValue x
Generic,Int -> HarmonClosedValue -> ShowS
[HarmonClosedValue] -> ShowS
HarmonClosedValue -> String
(Int -> HarmonClosedValue -> ShowS)
-> (HarmonClosedValue -> String)
-> ([HarmonClosedValue] -> ShowS)
-> Show HarmonClosedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonClosedValue] -> ShowS
$cshowList :: [HarmonClosedValue] -> ShowS
show :: HarmonClosedValue -> String
$cshow :: HarmonClosedValue -> String
showsPrec :: Int -> HarmonClosedValue -> ShowS
$cshowsPrec :: Int -> HarmonClosedValue -> ShowS
Show,Eq HarmonClosedValue
Eq HarmonClosedValue
-> (HarmonClosedValue -> HarmonClosedValue -> Ordering)
-> (HarmonClosedValue -> HarmonClosedValue -> Bool)
-> (HarmonClosedValue -> HarmonClosedValue -> Bool)
-> (HarmonClosedValue -> HarmonClosedValue -> Bool)
-> (HarmonClosedValue -> HarmonClosedValue -> Bool)
-> (HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue)
-> (HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue)
-> Ord HarmonClosedValue
HarmonClosedValue -> HarmonClosedValue -> Bool
HarmonClosedValue -> HarmonClosedValue -> Ordering
HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue
$cmin :: HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue
max :: HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue
$cmax :: HarmonClosedValue -> HarmonClosedValue -> HarmonClosedValue
>= :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c>= :: HarmonClosedValue -> HarmonClosedValue -> Bool
> :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c> :: HarmonClosedValue -> HarmonClosedValue -> Bool
<= :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c<= :: HarmonClosedValue -> HarmonClosedValue -> Bool
< :: HarmonClosedValue -> HarmonClosedValue -> Bool
$c< :: HarmonClosedValue -> HarmonClosedValue -> Bool
compare :: HarmonClosedValue -> HarmonClosedValue -> Ordering
$ccompare :: HarmonClosedValue -> HarmonClosedValue -> Ordering
$cp1Ord :: Eq HarmonClosedValue
Ord,Int -> HarmonClosedValue
HarmonClosedValue -> Int
HarmonClosedValue -> [HarmonClosedValue]
HarmonClosedValue -> HarmonClosedValue
HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
HarmonClosedValue
-> HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
(HarmonClosedValue -> HarmonClosedValue)
-> (HarmonClosedValue -> HarmonClosedValue)
-> (Int -> HarmonClosedValue)
-> (HarmonClosedValue -> Int)
-> (HarmonClosedValue -> [HarmonClosedValue])
-> (HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue])
-> (HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue])
-> (HarmonClosedValue
    -> HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue])
-> Enum HarmonClosedValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HarmonClosedValue
-> HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
$cenumFromThenTo :: HarmonClosedValue
-> HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
enumFromTo :: HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
$cenumFromTo :: HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
enumFromThen :: HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
$cenumFromThen :: HarmonClosedValue -> HarmonClosedValue -> [HarmonClosedValue]
enumFrom :: HarmonClosedValue -> [HarmonClosedValue]
$cenumFrom :: HarmonClosedValue -> [HarmonClosedValue]
fromEnum :: HarmonClosedValue -> Int
$cfromEnum :: HarmonClosedValue -> Int
toEnum :: Int -> HarmonClosedValue
$ctoEnum :: Int -> HarmonClosedValue
pred :: HarmonClosedValue -> HarmonClosedValue
$cpred :: HarmonClosedValue -> HarmonClosedValue
succ :: HarmonClosedValue -> HarmonClosedValue
$csucc :: HarmonClosedValue -> HarmonClosedValue
Enum,HarmonClosedValue
HarmonClosedValue -> HarmonClosedValue -> Bounded HarmonClosedValue
forall a. a -> a -> Bounded a
maxBound :: HarmonClosedValue
$cmaxBound :: HarmonClosedValue
minBound :: HarmonClosedValue
$cminBound :: HarmonClosedValue
Bounded)
instance EmitXml HarmonClosedValue where
    emitXml :: HarmonClosedValue -> XmlRep
emitXml HarmonClosedValue
HarmonClosedValueYes = String -> XmlRep
XLit String
"yes"
    emitXml HarmonClosedValue
HarmonClosedValueNo = String -> XmlRep
XLit String
"no"
    emitXml HarmonClosedValue
HarmonClosedValueHalf = String -> XmlRep
XLit String
"half"
parseHarmonClosedValue :: String -> P.XParse HarmonClosedValue
parseHarmonClosedValue :: String -> XParse HarmonClosedValue
parseHarmonClosedValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yes" = HarmonClosedValue -> XParse HarmonClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedValue -> XParse HarmonClosedValue)
-> HarmonClosedValue -> XParse HarmonClosedValue
forall a b. (a -> b) -> a -> b
$ HarmonClosedValue
HarmonClosedValueYes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"no" = HarmonClosedValue -> XParse HarmonClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedValue -> XParse HarmonClosedValue)
-> HarmonClosedValue -> XParse HarmonClosedValue
forall a b. (a -> b) -> a -> b
$ HarmonClosedValue
HarmonClosedValueNo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half" = HarmonClosedValue -> XParse HarmonClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonClosedValue -> XParse HarmonClosedValue)
-> HarmonClosedValue -> XParse HarmonClosedValue
forall a b. (a -> b) -> a -> b
$ HarmonClosedValue
HarmonClosedValueHalf
        | Bool
otherwise = String -> XParse HarmonClosedValue
forall a. String -> XParse a
P.xfail (String -> XParse HarmonClosedValue)
-> String -> XParse HarmonClosedValue
forall a b. (a -> b) -> a -> b
$ String
"HarmonClosedValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @harmony-type@ /(simple)/
--
-- The harmony-type type differentiates different types of harmonies when alternate harmonies are possible. Explicit harmonies have all note present in the music; implied have some notes missing but implied; alternate represents alternate analyses.
data HarmonyType = 
      HarmonyTypeExplicit -- ^ /explicit/
    | HarmonyTypeImplied -- ^ /implied/
    | HarmonyTypeAlternate -- ^ /alternate/
    deriving (HarmonyType -> HarmonyType -> Bool
(HarmonyType -> HarmonyType -> Bool)
-> (HarmonyType -> HarmonyType -> Bool) -> Eq HarmonyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonyType -> HarmonyType -> Bool
$c/= :: HarmonyType -> HarmonyType -> Bool
== :: HarmonyType -> HarmonyType -> Bool
$c== :: HarmonyType -> HarmonyType -> Bool
Eq,Typeable,(forall x. HarmonyType -> Rep HarmonyType x)
-> (forall x. Rep HarmonyType x -> HarmonyType)
-> Generic HarmonyType
forall x. Rep HarmonyType x -> HarmonyType
forall x. HarmonyType -> Rep HarmonyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonyType x -> HarmonyType
$cfrom :: forall x. HarmonyType -> Rep HarmonyType x
Generic,Int -> HarmonyType -> ShowS
[HarmonyType] -> ShowS
HarmonyType -> String
(Int -> HarmonyType -> ShowS)
-> (HarmonyType -> String)
-> ([HarmonyType] -> ShowS)
-> Show HarmonyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonyType] -> ShowS
$cshowList :: [HarmonyType] -> ShowS
show :: HarmonyType -> String
$cshow :: HarmonyType -> String
showsPrec :: Int -> HarmonyType -> ShowS
$cshowsPrec :: Int -> HarmonyType -> ShowS
Show,Eq HarmonyType
Eq HarmonyType
-> (HarmonyType -> HarmonyType -> Ordering)
-> (HarmonyType -> HarmonyType -> Bool)
-> (HarmonyType -> HarmonyType -> Bool)
-> (HarmonyType -> HarmonyType -> Bool)
-> (HarmonyType -> HarmonyType -> Bool)
-> (HarmonyType -> HarmonyType -> HarmonyType)
-> (HarmonyType -> HarmonyType -> HarmonyType)
-> Ord HarmonyType
HarmonyType -> HarmonyType -> Bool
HarmonyType -> HarmonyType -> Ordering
HarmonyType -> HarmonyType -> HarmonyType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HarmonyType -> HarmonyType -> HarmonyType
$cmin :: HarmonyType -> HarmonyType -> HarmonyType
max :: HarmonyType -> HarmonyType -> HarmonyType
$cmax :: HarmonyType -> HarmonyType -> HarmonyType
>= :: HarmonyType -> HarmonyType -> Bool
$c>= :: HarmonyType -> HarmonyType -> Bool
> :: HarmonyType -> HarmonyType -> Bool
$c> :: HarmonyType -> HarmonyType -> Bool
<= :: HarmonyType -> HarmonyType -> Bool
$c<= :: HarmonyType -> HarmonyType -> Bool
< :: HarmonyType -> HarmonyType -> Bool
$c< :: HarmonyType -> HarmonyType -> Bool
compare :: HarmonyType -> HarmonyType -> Ordering
$ccompare :: HarmonyType -> HarmonyType -> Ordering
$cp1Ord :: Eq HarmonyType
Ord,Int -> HarmonyType
HarmonyType -> Int
HarmonyType -> [HarmonyType]
HarmonyType -> HarmonyType
HarmonyType -> HarmonyType -> [HarmonyType]
HarmonyType -> HarmonyType -> HarmonyType -> [HarmonyType]
(HarmonyType -> HarmonyType)
-> (HarmonyType -> HarmonyType)
-> (Int -> HarmonyType)
-> (HarmonyType -> Int)
-> (HarmonyType -> [HarmonyType])
-> (HarmonyType -> HarmonyType -> [HarmonyType])
-> (HarmonyType -> HarmonyType -> [HarmonyType])
-> (HarmonyType -> HarmonyType -> HarmonyType -> [HarmonyType])
-> Enum HarmonyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HarmonyType -> HarmonyType -> HarmonyType -> [HarmonyType]
$cenumFromThenTo :: HarmonyType -> HarmonyType -> HarmonyType -> [HarmonyType]
enumFromTo :: HarmonyType -> HarmonyType -> [HarmonyType]
$cenumFromTo :: HarmonyType -> HarmonyType -> [HarmonyType]
enumFromThen :: HarmonyType -> HarmonyType -> [HarmonyType]
$cenumFromThen :: HarmonyType -> HarmonyType -> [HarmonyType]
enumFrom :: HarmonyType -> [HarmonyType]
$cenumFrom :: HarmonyType -> [HarmonyType]
fromEnum :: HarmonyType -> Int
$cfromEnum :: HarmonyType -> Int
toEnum :: Int -> HarmonyType
$ctoEnum :: Int -> HarmonyType
pred :: HarmonyType -> HarmonyType
$cpred :: HarmonyType -> HarmonyType
succ :: HarmonyType -> HarmonyType
$csucc :: HarmonyType -> HarmonyType
Enum,HarmonyType
HarmonyType -> HarmonyType -> Bounded HarmonyType
forall a. a -> a -> Bounded a
maxBound :: HarmonyType
$cmaxBound :: HarmonyType
minBound :: HarmonyType
$cminBound :: HarmonyType
Bounded)
instance EmitXml HarmonyType where
    emitXml :: HarmonyType -> XmlRep
emitXml HarmonyType
HarmonyTypeExplicit = String -> XmlRep
XLit String
"explicit"
    emitXml HarmonyType
HarmonyTypeImplied = String -> XmlRep
XLit String
"implied"
    emitXml HarmonyType
HarmonyTypeAlternate = String -> XmlRep
XLit String
"alternate"
parseHarmonyType :: String -> P.XParse HarmonyType
parseHarmonyType :: String -> XParse HarmonyType
parseHarmonyType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"explicit" = HarmonyType -> XParse HarmonyType
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonyType -> XParse HarmonyType)
-> HarmonyType -> XParse HarmonyType
forall a b. (a -> b) -> a -> b
$ HarmonyType
HarmonyTypeExplicit
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"implied" = HarmonyType -> XParse HarmonyType
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonyType -> XParse HarmonyType)
-> HarmonyType -> XParse HarmonyType
forall a b. (a -> b) -> a -> b
$ HarmonyType
HarmonyTypeImplied
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"alternate" = HarmonyType -> XParse HarmonyType
forall (m :: * -> *) a. Monad m => a -> m a
return (HarmonyType -> XParse HarmonyType)
-> HarmonyType -> XParse HarmonyType
forall a b. (a -> b) -> a -> b
$ HarmonyType
HarmonyTypeAlternate
        | Bool
otherwise = String -> XParse HarmonyType
forall a. String -> XParse a
P.xfail (String -> XParse HarmonyType) -> String -> XParse HarmonyType
forall a b. (a -> b) -> a -> b
$ String
"HarmonyType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @hole-closed-location@ /(simple)/
--
-- The hole-closed-location type indicates which portion of the hole is filled in when the corresponding hole-closed-value is half.
data HoleClosedLocation = 
      HoleClosedLocationRight -- ^ /right/
    | HoleClosedLocationBottom -- ^ /bottom/
    | HoleClosedLocationLeft -- ^ /left/
    | HoleClosedLocationTop -- ^ /top/
    deriving (HoleClosedLocation -> HoleClosedLocation -> Bool
(HoleClosedLocation -> HoleClosedLocation -> Bool)
-> (HoleClosedLocation -> HoleClosedLocation -> Bool)
-> Eq HoleClosedLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c/= :: HoleClosedLocation -> HoleClosedLocation -> Bool
== :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c== :: HoleClosedLocation -> HoleClosedLocation -> Bool
Eq,Typeable,(forall x. HoleClosedLocation -> Rep HoleClosedLocation x)
-> (forall x. Rep HoleClosedLocation x -> HoleClosedLocation)
-> Generic HoleClosedLocation
forall x. Rep HoleClosedLocation x -> HoleClosedLocation
forall x. HoleClosedLocation -> Rep HoleClosedLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoleClosedLocation x -> HoleClosedLocation
$cfrom :: forall x. HoleClosedLocation -> Rep HoleClosedLocation x
Generic,Int -> HoleClosedLocation -> ShowS
[HoleClosedLocation] -> ShowS
HoleClosedLocation -> String
(Int -> HoleClosedLocation -> ShowS)
-> (HoleClosedLocation -> String)
-> ([HoleClosedLocation] -> ShowS)
-> Show HoleClosedLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoleClosedLocation] -> ShowS
$cshowList :: [HoleClosedLocation] -> ShowS
show :: HoleClosedLocation -> String
$cshow :: HoleClosedLocation -> String
showsPrec :: Int -> HoleClosedLocation -> ShowS
$cshowsPrec :: Int -> HoleClosedLocation -> ShowS
Show,Eq HoleClosedLocation
Eq HoleClosedLocation
-> (HoleClosedLocation -> HoleClosedLocation -> Ordering)
-> (HoleClosedLocation -> HoleClosedLocation -> Bool)
-> (HoleClosedLocation -> HoleClosedLocation -> Bool)
-> (HoleClosedLocation -> HoleClosedLocation -> Bool)
-> (HoleClosedLocation -> HoleClosedLocation -> Bool)
-> (HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation)
-> (HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation)
-> Ord HoleClosedLocation
HoleClosedLocation -> HoleClosedLocation -> Bool
HoleClosedLocation -> HoleClosedLocation -> Ordering
HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation
$cmin :: HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation
max :: HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation
$cmax :: HoleClosedLocation -> HoleClosedLocation -> HoleClosedLocation
>= :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c>= :: HoleClosedLocation -> HoleClosedLocation -> Bool
> :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c> :: HoleClosedLocation -> HoleClosedLocation -> Bool
<= :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c<= :: HoleClosedLocation -> HoleClosedLocation -> Bool
< :: HoleClosedLocation -> HoleClosedLocation -> Bool
$c< :: HoleClosedLocation -> HoleClosedLocation -> Bool
compare :: HoleClosedLocation -> HoleClosedLocation -> Ordering
$ccompare :: HoleClosedLocation -> HoleClosedLocation -> Ordering
$cp1Ord :: Eq HoleClosedLocation
Ord,Int -> HoleClosedLocation
HoleClosedLocation -> Int
HoleClosedLocation -> [HoleClosedLocation]
HoleClosedLocation -> HoleClosedLocation
HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
HoleClosedLocation
-> HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
(HoleClosedLocation -> HoleClosedLocation)
-> (HoleClosedLocation -> HoleClosedLocation)
-> (Int -> HoleClosedLocation)
-> (HoleClosedLocation -> Int)
-> (HoleClosedLocation -> [HoleClosedLocation])
-> (HoleClosedLocation
    -> HoleClosedLocation -> [HoleClosedLocation])
-> (HoleClosedLocation
    -> HoleClosedLocation -> [HoleClosedLocation])
-> (HoleClosedLocation
    -> HoleClosedLocation
    -> HoleClosedLocation
    -> [HoleClosedLocation])
-> Enum HoleClosedLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HoleClosedLocation
-> HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
$cenumFromThenTo :: HoleClosedLocation
-> HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
enumFromTo :: HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
$cenumFromTo :: HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
enumFromThen :: HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
$cenumFromThen :: HoleClosedLocation -> HoleClosedLocation -> [HoleClosedLocation]
enumFrom :: HoleClosedLocation -> [HoleClosedLocation]
$cenumFrom :: HoleClosedLocation -> [HoleClosedLocation]
fromEnum :: HoleClosedLocation -> Int
$cfromEnum :: HoleClosedLocation -> Int
toEnum :: Int -> HoleClosedLocation
$ctoEnum :: Int -> HoleClosedLocation
pred :: HoleClosedLocation -> HoleClosedLocation
$cpred :: HoleClosedLocation -> HoleClosedLocation
succ :: HoleClosedLocation -> HoleClosedLocation
$csucc :: HoleClosedLocation -> HoleClosedLocation
Enum,HoleClosedLocation
HoleClosedLocation
-> HoleClosedLocation -> Bounded HoleClosedLocation
forall a. a -> a -> Bounded a
maxBound :: HoleClosedLocation
$cmaxBound :: HoleClosedLocation
minBound :: HoleClosedLocation
$cminBound :: HoleClosedLocation
Bounded)
instance EmitXml HoleClosedLocation where
    emitXml :: HoleClosedLocation -> XmlRep
emitXml HoleClosedLocation
HoleClosedLocationRight = String -> XmlRep
XLit String
"right"
    emitXml HoleClosedLocation
HoleClosedLocationBottom = String -> XmlRep
XLit String
"bottom"
    emitXml HoleClosedLocation
HoleClosedLocationLeft = String -> XmlRep
XLit String
"left"
    emitXml HoleClosedLocation
HoleClosedLocationTop = String -> XmlRep
XLit String
"top"
parseHoleClosedLocation :: String -> P.XParse HoleClosedLocation
parseHoleClosedLocation :: String -> XParse HoleClosedLocation
parseHoleClosedLocation String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = HoleClosedLocation -> XParse HoleClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedLocation -> XParse HoleClosedLocation)
-> HoleClosedLocation -> XParse HoleClosedLocation
forall a b. (a -> b) -> a -> b
$ HoleClosedLocation
HoleClosedLocationRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bottom" = HoleClosedLocation -> XParse HoleClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedLocation -> XParse HoleClosedLocation)
-> HoleClosedLocation -> XParse HoleClosedLocation
forall a b. (a -> b) -> a -> b
$ HoleClosedLocation
HoleClosedLocationBottom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = HoleClosedLocation -> XParse HoleClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedLocation -> XParse HoleClosedLocation)
-> HoleClosedLocation -> XParse HoleClosedLocation
forall a b. (a -> b) -> a -> b
$ HoleClosedLocation
HoleClosedLocationLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"top" = HoleClosedLocation -> XParse HoleClosedLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedLocation -> XParse HoleClosedLocation)
-> HoleClosedLocation -> XParse HoleClosedLocation
forall a b. (a -> b) -> a -> b
$ HoleClosedLocation
HoleClosedLocationTop
        | Bool
otherwise = String -> XParse HoleClosedLocation
forall a. String -> XParse a
P.xfail (String -> XParse HoleClosedLocation)
-> String -> XParse HoleClosedLocation
forall a b. (a -> b) -> a -> b
$ String
"HoleClosedLocation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @hole-closed-value@ /(simple)/
--
-- The hole-closed-value type represents whether the hole is closed, open, or half-open.
data HoleClosedValue = 
      HoleClosedValueYes -- ^ /yes/
    | HoleClosedValueNo -- ^ /no/
    | HoleClosedValueHalf -- ^ /half/
    deriving (HoleClosedValue -> HoleClosedValue -> Bool
(HoleClosedValue -> HoleClosedValue -> Bool)
-> (HoleClosedValue -> HoleClosedValue -> Bool)
-> Eq HoleClosedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoleClosedValue -> HoleClosedValue -> Bool
$c/= :: HoleClosedValue -> HoleClosedValue -> Bool
== :: HoleClosedValue -> HoleClosedValue -> Bool
$c== :: HoleClosedValue -> HoleClosedValue -> Bool
Eq,Typeable,(forall x. HoleClosedValue -> Rep HoleClosedValue x)
-> (forall x. Rep HoleClosedValue x -> HoleClosedValue)
-> Generic HoleClosedValue
forall x. Rep HoleClosedValue x -> HoleClosedValue
forall x. HoleClosedValue -> Rep HoleClosedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoleClosedValue x -> HoleClosedValue
$cfrom :: forall x. HoleClosedValue -> Rep HoleClosedValue x
Generic,Int -> HoleClosedValue -> ShowS
[HoleClosedValue] -> ShowS
HoleClosedValue -> String
(Int -> HoleClosedValue -> ShowS)
-> (HoleClosedValue -> String)
-> ([HoleClosedValue] -> ShowS)
-> Show HoleClosedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoleClosedValue] -> ShowS
$cshowList :: [HoleClosedValue] -> ShowS
show :: HoleClosedValue -> String
$cshow :: HoleClosedValue -> String
showsPrec :: Int -> HoleClosedValue -> ShowS
$cshowsPrec :: Int -> HoleClosedValue -> ShowS
Show,Eq HoleClosedValue
Eq HoleClosedValue
-> (HoleClosedValue -> HoleClosedValue -> Ordering)
-> (HoleClosedValue -> HoleClosedValue -> Bool)
-> (HoleClosedValue -> HoleClosedValue -> Bool)
-> (HoleClosedValue -> HoleClosedValue -> Bool)
-> (HoleClosedValue -> HoleClosedValue -> Bool)
-> (HoleClosedValue -> HoleClosedValue -> HoleClosedValue)
-> (HoleClosedValue -> HoleClosedValue -> HoleClosedValue)
-> Ord HoleClosedValue
HoleClosedValue -> HoleClosedValue -> Bool
HoleClosedValue -> HoleClosedValue -> Ordering
HoleClosedValue -> HoleClosedValue -> HoleClosedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HoleClosedValue -> HoleClosedValue -> HoleClosedValue
$cmin :: HoleClosedValue -> HoleClosedValue -> HoleClosedValue
max :: HoleClosedValue -> HoleClosedValue -> HoleClosedValue
$cmax :: HoleClosedValue -> HoleClosedValue -> HoleClosedValue
>= :: HoleClosedValue -> HoleClosedValue -> Bool
$c>= :: HoleClosedValue -> HoleClosedValue -> Bool
> :: HoleClosedValue -> HoleClosedValue -> Bool
$c> :: HoleClosedValue -> HoleClosedValue -> Bool
<= :: HoleClosedValue -> HoleClosedValue -> Bool
$c<= :: HoleClosedValue -> HoleClosedValue -> Bool
< :: HoleClosedValue -> HoleClosedValue -> Bool
$c< :: HoleClosedValue -> HoleClosedValue -> Bool
compare :: HoleClosedValue -> HoleClosedValue -> Ordering
$ccompare :: HoleClosedValue -> HoleClosedValue -> Ordering
$cp1Ord :: Eq HoleClosedValue
Ord,Int -> HoleClosedValue
HoleClosedValue -> Int
HoleClosedValue -> [HoleClosedValue]
HoleClosedValue -> HoleClosedValue
HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
HoleClosedValue
-> HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
(HoleClosedValue -> HoleClosedValue)
-> (HoleClosedValue -> HoleClosedValue)
-> (Int -> HoleClosedValue)
-> (HoleClosedValue -> Int)
-> (HoleClosedValue -> [HoleClosedValue])
-> (HoleClosedValue -> HoleClosedValue -> [HoleClosedValue])
-> (HoleClosedValue -> HoleClosedValue -> [HoleClosedValue])
-> (HoleClosedValue
    -> HoleClosedValue -> HoleClosedValue -> [HoleClosedValue])
-> Enum HoleClosedValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HoleClosedValue
-> HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
$cenumFromThenTo :: HoleClosedValue
-> HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
enumFromTo :: HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
$cenumFromTo :: HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
enumFromThen :: HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
$cenumFromThen :: HoleClosedValue -> HoleClosedValue -> [HoleClosedValue]
enumFrom :: HoleClosedValue -> [HoleClosedValue]
$cenumFrom :: HoleClosedValue -> [HoleClosedValue]
fromEnum :: HoleClosedValue -> Int
$cfromEnum :: HoleClosedValue -> Int
toEnum :: Int -> HoleClosedValue
$ctoEnum :: Int -> HoleClosedValue
pred :: HoleClosedValue -> HoleClosedValue
$cpred :: HoleClosedValue -> HoleClosedValue
succ :: HoleClosedValue -> HoleClosedValue
$csucc :: HoleClosedValue -> HoleClosedValue
Enum,HoleClosedValue
HoleClosedValue -> HoleClosedValue -> Bounded HoleClosedValue
forall a. a -> a -> Bounded a
maxBound :: HoleClosedValue
$cmaxBound :: HoleClosedValue
minBound :: HoleClosedValue
$cminBound :: HoleClosedValue
Bounded)
instance EmitXml HoleClosedValue where
    emitXml :: HoleClosedValue -> XmlRep
emitXml HoleClosedValue
HoleClosedValueYes = String -> XmlRep
XLit String
"yes"
    emitXml HoleClosedValue
HoleClosedValueNo = String -> XmlRep
XLit String
"no"
    emitXml HoleClosedValue
HoleClosedValueHalf = String -> XmlRep
XLit String
"half"
parseHoleClosedValue :: String -> P.XParse HoleClosedValue
parseHoleClosedValue :: String -> XParse HoleClosedValue
parseHoleClosedValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yes" = HoleClosedValue -> XParse HoleClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedValue -> XParse HoleClosedValue)
-> HoleClosedValue -> XParse HoleClosedValue
forall a b. (a -> b) -> a -> b
$ HoleClosedValue
HoleClosedValueYes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"no" = HoleClosedValue -> XParse HoleClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedValue -> XParse HoleClosedValue)
-> HoleClosedValue -> XParse HoleClosedValue
forall a b. (a -> b) -> a -> b
$ HoleClosedValue
HoleClosedValueNo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half" = HoleClosedValue -> XParse HoleClosedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (HoleClosedValue -> XParse HoleClosedValue)
-> HoleClosedValue -> XParse HoleClosedValue
forall a b. (a -> b) -> a -> b
$ HoleClosedValue
HoleClosedValueHalf
        | Bool
otherwise = String -> XParse HoleClosedValue
forall a. String -> XParse a
P.xfail (String -> XParse HoleClosedValue)
-> String -> XParse HoleClosedValue
forall a b. (a -> b) -> a -> b
$ String
"HoleClosedValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @kind-value@ /(simple)/
--
-- A kind-value indicates the type of chord. Degree elements can then add, subtract, or alter from these starting points. Values include:
--
-- @
-- 
-- Triads:
-- 	major (major third, perfect fifth)
-- 	minor (minor third, perfect fifth)
-- 	augmented (major third, augmented fifth)
-- 	diminished (minor third, diminished fifth)
-- Sevenths:
-- 	dominant (major triad, minor seventh)
-- 	major-seventh (major triad, major seventh)
-- 	minor-seventh (minor triad, minor seventh)
-- 	diminished-seventh (diminished triad, diminished seventh)
-- 	augmented-seventh (augmented triad, minor seventh)
-- 	half-diminished (diminished triad, minor seventh)
-- 	major-minor (minor triad, major seventh)
-- Sixths:
-- 	major-sixth (major triad, added sixth)
-- 	minor-sixth (minor triad, added sixth)
-- Ninths:
-- 	dominant-ninth (dominant-seventh, major ninth)
-- 	major-ninth (major-seventh, major ninth)
-- 	minor-ninth (minor-seventh, major ninth)
-- 11ths (usually as the basis for alteration):
-- 	dominant-11th (dominant-ninth, perfect 11th)
-- 	major-11th (major-ninth, perfect 11th)
-- 	minor-11th (minor-ninth, perfect 11th)
-- 13ths (usually as the basis for alteration):
-- 	dominant-13th (dominant-11th, major 13th)
-- 	major-13th (major-11th, major 13th)
-- 	minor-13th (minor-11th, major 13th)
-- Suspended:
-- 	suspended-second (major second, perfect fifth)
-- 	suspended-fourth (perfect fourth, perfect fifth)
-- Functional sixths:
-- 	Neapolitan
-- 	Italian
-- 	French
-- 	German
-- Other:
-- 	pedal (pedal-point bass)
-- 	power (perfect fifth)
-- 	Tristan
-- 
-- The "other" kind is used when the harmony is entirely composed of add elements. The "none" kind is used to explicitly encode absence of chords or functional harmony.
-- @
data KindValue = 
      KindValueMajor -- ^ /major/
    | KindValueMinor -- ^ /minor/
    | KindValueAugmented -- ^ /augmented/
    | KindValueDiminished -- ^ /diminished/
    | KindValueDominant -- ^ /dominant/
    | KindValueMajorSeventh -- ^ /major-seventh/
    | KindValueMinorSeventh -- ^ /minor-seventh/
    | KindValueDiminishedSeventh -- ^ /diminished-seventh/
    | KindValueAugmentedSeventh -- ^ /augmented-seventh/
    | KindValueHalfDiminished -- ^ /half-diminished/
    | KindValueMajorMinor -- ^ /major-minor/
    | KindValueMajorSixth -- ^ /major-sixth/
    | KindValueMinorSixth -- ^ /minor-sixth/
    | KindValueDominantNinth -- ^ /dominant-ninth/
    | KindValueMajorNinth -- ^ /major-ninth/
    | KindValueMinorNinth -- ^ /minor-ninth/
    | KindValueDominant11th -- ^ /dominant-11th/
    | KindValueMajor11th -- ^ /major-11th/
    | KindValueMinor11th -- ^ /minor-11th/
    | KindValueDominant13th -- ^ /dominant-13th/
    | KindValueMajor13th -- ^ /major-13th/
    | KindValueMinor13th -- ^ /minor-13th/
    | KindValueSuspendedSecond -- ^ /suspended-second/
    | KindValueSuspendedFourth -- ^ /suspended-fourth/
    | KindValueNeapolitan -- ^ /Neapolitan/
    | KindValueItalian -- ^ /Italian/
    | KindValueFrench -- ^ /French/
    | KindValueGerman -- ^ /German/
    | KindValuePedal -- ^ /pedal/
    | KindValuePower -- ^ /power/
    | KindValueTristan -- ^ /Tristan/
    | KindValueOther -- ^ /other/
    | KindValueNone -- ^ /none/
    deriving (KindValue -> KindValue -> Bool
(KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool) -> Eq KindValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KindValue -> KindValue -> Bool
$c/= :: KindValue -> KindValue -> Bool
== :: KindValue -> KindValue -> Bool
$c== :: KindValue -> KindValue -> Bool
Eq,Typeable,(forall x. KindValue -> Rep KindValue x)
-> (forall x. Rep KindValue x -> KindValue) -> Generic KindValue
forall x. Rep KindValue x -> KindValue
forall x. KindValue -> Rep KindValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KindValue x -> KindValue
$cfrom :: forall x. KindValue -> Rep KindValue x
Generic,Int -> KindValue -> ShowS
[KindValue] -> ShowS
KindValue -> String
(Int -> KindValue -> ShowS)
-> (KindValue -> String)
-> ([KindValue] -> ShowS)
-> Show KindValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KindValue] -> ShowS
$cshowList :: [KindValue] -> ShowS
show :: KindValue -> String
$cshow :: KindValue -> String
showsPrec :: Int -> KindValue -> ShowS
$cshowsPrec :: Int -> KindValue -> ShowS
Show,Eq KindValue
Eq KindValue
-> (KindValue -> KindValue -> Ordering)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> Bool)
-> (KindValue -> KindValue -> KindValue)
-> (KindValue -> KindValue -> KindValue)
-> Ord KindValue
KindValue -> KindValue -> Bool
KindValue -> KindValue -> Ordering
KindValue -> KindValue -> KindValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: KindValue -> KindValue -> KindValue
$cmin :: KindValue -> KindValue -> KindValue
max :: KindValue -> KindValue -> KindValue
$cmax :: KindValue -> KindValue -> KindValue
>= :: KindValue -> KindValue -> Bool
$c>= :: KindValue -> KindValue -> Bool
> :: KindValue -> KindValue -> Bool
$c> :: KindValue -> KindValue -> Bool
<= :: KindValue -> KindValue -> Bool
$c<= :: KindValue -> KindValue -> Bool
< :: KindValue -> KindValue -> Bool
$c< :: KindValue -> KindValue -> Bool
compare :: KindValue -> KindValue -> Ordering
$ccompare :: KindValue -> KindValue -> Ordering
$cp1Ord :: Eq KindValue
Ord,Int -> KindValue
KindValue -> Int
KindValue -> [KindValue]
KindValue -> KindValue
KindValue -> KindValue -> [KindValue]
KindValue -> KindValue -> KindValue -> [KindValue]
(KindValue -> KindValue)
-> (KindValue -> KindValue)
-> (Int -> KindValue)
-> (KindValue -> Int)
-> (KindValue -> [KindValue])
-> (KindValue -> KindValue -> [KindValue])
-> (KindValue -> KindValue -> [KindValue])
-> (KindValue -> KindValue -> KindValue -> [KindValue])
-> Enum KindValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: KindValue -> KindValue -> KindValue -> [KindValue]
$cenumFromThenTo :: KindValue -> KindValue -> KindValue -> [KindValue]
enumFromTo :: KindValue -> KindValue -> [KindValue]
$cenumFromTo :: KindValue -> KindValue -> [KindValue]
enumFromThen :: KindValue -> KindValue -> [KindValue]
$cenumFromThen :: KindValue -> KindValue -> [KindValue]
enumFrom :: KindValue -> [KindValue]
$cenumFrom :: KindValue -> [KindValue]
fromEnum :: KindValue -> Int
$cfromEnum :: KindValue -> Int
toEnum :: Int -> KindValue
$ctoEnum :: Int -> KindValue
pred :: KindValue -> KindValue
$cpred :: KindValue -> KindValue
succ :: KindValue -> KindValue
$csucc :: KindValue -> KindValue
Enum,KindValue
KindValue -> KindValue -> Bounded KindValue
forall a. a -> a -> Bounded a
maxBound :: KindValue
$cmaxBound :: KindValue
minBound :: KindValue
$cminBound :: KindValue
Bounded)
instance EmitXml KindValue where
    emitXml :: KindValue -> XmlRep
emitXml KindValue
KindValueMajor = String -> XmlRep
XLit String
"major"
    emitXml KindValue
KindValueMinor = String -> XmlRep
XLit String
"minor"
    emitXml KindValue
KindValueAugmented = String -> XmlRep
XLit String
"augmented"
    emitXml KindValue
KindValueDiminished = String -> XmlRep
XLit String
"diminished"
    emitXml KindValue
KindValueDominant = String -> XmlRep
XLit String
"dominant"
    emitXml KindValue
KindValueMajorSeventh = String -> XmlRep
XLit String
"major-seventh"
    emitXml KindValue
KindValueMinorSeventh = String -> XmlRep
XLit String
"minor-seventh"
    emitXml KindValue
KindValueDiminishedSeventh = String -> XmlRep
XLit String
"diminished-seventh"
    emitXml KindValue
KindValueAugmentedSeventh = String -> XmlRep
XLit String
"augmented-seventh"
    emitXml KindValue
KindValueHalfDiminished = String -> XmlRep
XLit String
"half-diminished"
    emitXml KindValue
KindValueMajorMinor = String -> XmlRep
XLit String
"major-minor"
    emitXml KindValue
KindValueMajorSixth = String -> XmlRep
XLit String
"major-sixth"
    emitXml KindValue
KindValueMinorSixth = String -> XmlRep
XLit String
"minor-sixth"
    emitXml KindValue
KindValueDominantNinth = String -> XmlRep
XLit String
"dominant-ninth"
    emitXml KindValue
KindValueMajorNinth = String -> XmlRep
XLit String
"major-ninth"
    emitXml KindValue
KindValueMinorNinth = String -> XmlRep
XLit String
"minor-ninth"
    emitXml KindValue
KindValueDominant11th = String -> XmlRep
XLit String
"dominant-11th"
    emitXml KindValue
KindValueMajor11th = String -> XmlRep
XLit String
"major-11th"
    emitXml KindValue
KindValueMinor11th = String -> XmlRep
XLit String
"minor-11th"
    emitXml KindValue
KindValueDominant13th = String -> XmlRep
XLit String
"dominant-13th"
    emitXml KindValue
KindValueMajor13th = String -> XmlRep
XLit String
"major-13th"
    emitXml KindValue
KindValueMinor13th = String -> XmlRep
XLit String
"minor-13th"
    emitXml KindValue
KindValueSuspendedSecond = String -> XmlRep
XLit String
"suspended-second"
    emitXml KindValue
KindValueSuspendedFourth = String -> XmlRep
XLit String
"suspended-fourth"
    emitXml KindValue
KindValueNeapolitan = String -> XmlRep
XLit String
"Neapolitan"
    emitXml KindValue
KindValueItalian = String -> XmlRep
XLit String
"Italian"
    emitXml KindValue
KindValueFrench = String -> XmlRep
XLit String
"French"
    emitXml KindValue
KindValueGerman = String -> XmlRep
XLit String
"German"
    emitXml KindValue
KindValuePedal = String -> XmlRep
XLit String
"pedal"
    emitXml KindValue
KindValuePower = String -> XmlRep
XLit String
"power"
    emitXml KindValue
KindValueTristan = String -> XmlRep
XLit String
"Tristan"
    emitXml KindValue
KindValueOther = String -> XmlRep
XLit String
"other"
    emitXml KindValue
KindValueNone = String -> XmlRep
XLit String
"none"
parseKindValue :: String -> P.XParse KindValue
parseKindValue :: String -> XParse KindValue
parseKindValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajor
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinor
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"augmented" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueAugmented
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diminished" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDiminished
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dominant" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDominant
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-seventh" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajorSeventh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor-seventh" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinorSeventh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diminished-seventh" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDiminishedSeventh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"augmented-seventh" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueAugmentedSeventh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half-diminished" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueHalfDiminished
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-minor" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajorMinor
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-sixth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajorSixth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor-sixth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinorSixth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dominant-ninth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDominantNinth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-ninth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajorNinth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor-ninth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinorNinth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dominant-11th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDominant11th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-11th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajor11th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor-11th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinor11th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dominant-13th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueDominant13th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"major-13th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMajor13th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"minor-13th" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueMinor13th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"suspended-second" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueSuspendedSecond
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"suspended-fourth" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueSuspendedFourth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Neapolitan" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueNeapolitan
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Italian" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueItalian
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"French" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueFrench
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"German" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueGerman
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"pedal" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValuePedal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"power" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValuePower
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Tristan" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueTristan
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueOther
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = KindValue -> XParse KindValue
forall (m :: * -> *) a. Monad m => a -> m a
return (KindValue -> XParse KindValue) -> KindValue -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ KindValue
KindValueNone
        | Bool
otherwise = String -> XParse KindValue
forall a. String -> XParse a
P.xfail (String -> XParse KindValue) -> String -> XParse KindValue
forall a b. (a -> b) -> a -> b
$ String
"KindValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @xml:lang@ /(simple)/
data Lang = 
      LangLanguage {
          Lang -> Language
lang1 :: Language
       }
    | LangLang {
          Lang -> SumLang
lang2 :: SumLang
       }
    deriving (Lang -> Lang -> Bool
(Lang -> Lang -> Bool) -> (Lang -> Lang -> Bool) -> Eq Lang
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lang -> Lang -> Bool
$c/= :: Lang -> Lang -> Bool
== :: Lang -> Lang -> Bool
$c== :: Lang -> Lang -> Bool
Eq,Typeable,(forall x. Lang -> Rep Lang x)
-> (forall x. Rep Lang x -> Lang) -> Generic Lang
forall x. Rep Lang x -> Lang
forall x. Lang -> Rep Lang x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Lang x -> Lang
$cfrom :: forall x. Lang -> Rep Lang x
Generic,Int -> Lang -> ShowS
[Lang] -> ShowS
Lang -> String
(Int -> Lang -> ShowS)
-> (Lang -> String) -> ([Lang] -> ShowS) -> Show Lang
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lang] -> ShowS
$cshowList :: [Lang] -> ShowS
show :: Lang -> String
$cshow :: Lang -> String
showsPrec :: Int -> Lang -> ShowS
$cshowsPrec :: Int -> Lang -> ShowS
Show)
instance EmitXml Lang where
    emitXml :: Lang -> XmlRep
emitXml (LangLanguage Language
a) = Language -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Language
a
    emitXml (LangLang SumLang
a) = SumLang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SumLang
a
parseLang :: String -> P.XParse Lang
parseLang :: String -> XParse Lang
parseLang String
s = 
      Language -> Lang
LangLanguage
        (Language -> Lang) -> XParse Language -> XParse Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse Language
parseLanguage String
s
      XParse Lang -> XParse Lang -> XParse Lang
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SumLang -> Lang
LangLang
        (SumLang -> Lang) -> XParse SumLang -> XParse Lang
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse SumLang
parseSumLang String
s


-- | @xs:language@ /(simple)/
newtype Language = Language { Language -> Token
language :: Token }
    deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq,Typeable,(forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic,Eq Language
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
$cp1Ord :: Eq Language
Ord,String -> Language
(String -> Language) -> IsString Language
forall a. (String -> a) -> IsString a
fromString :: String -> Language
$cfromString :: String -> Language
IsString)
instance Show Language where show :: Language -> String
show (Language Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read Language where readsPrec :: Int -> ReadS Language
readsPrec Int
i = ((Token, String) -> (Language, String))
-> [(Token, String)] -> [(Language, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> Language) -> (Token, String) -> (Language, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> Language
Language) ([(Token, String)] -> [(Language, String)])
-> (String -> [(Token, String)]) -> ReadS Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Language where
    emitXml :: Language -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (Language -> Token) -> Language -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Token
language
parseLanguage :: String -> P.XParse Language
parseLanguage :: String -> XParse Language
parseLanguage = Language -> XParse Language
forall (m :: * -> *) a. Monad m => a -> m a
return (Language -> XParse Language)
-> (String -> Language) -> String -> XParse Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Language
forall a. IsString a => String -> a
fromString

-- | @left-center-right@ /(simple)/
--
-- The left-center-right type is used to define horizontal alignment and text justification.
data LeftCenterRight = 
      LeftCenterRightLeft -- ^ /left/
    | LeftCenterRightCenter -- ^ /center/
    | LeftCenterRightRight -- ^ /right/
    deriving (LeftCenterRight -> LeftCenterRight -> Bool
(LeftCenterRight -> LeftCenterRight -> Bool)
-> (LeftCenterRight -> LeftCenterRight -> Bool)
-> Eq LeftCenterRight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeftCenterRight -> LeftCenterRight -> Bool
$c/= :: LeftCenterRight -> LeftCenterRight -> Bool
== :: LeftCenterRight -> LeftCenterRight -> Bool
$c== :: LeftCenterRight -> LeftCenterRight -> Bool
Eq,Typeable,(forall x. LeftCenterRight -> Rep LeftCenterRight x)
-> (forall x. Rep LeftCenterRight x -> LeftCenterRight)
-> Generic LeftCenterRight
forall x. Rep LeftCenterRight x -> LeftCenterRight
forall x. LeftCenterRight -> Rep LeftCenterRight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LeftCenterRight x -> LeftCenterRight
$cfrom :: forall x. LeftCenterRight -> Rep LeftCenterRight x
Generic,Int -> LeftCenterRight -> ShowS
[LeftCenterRight] -> ShowS
LeftCenterRight -> String
(Int -> LeftCenterRight -> ShowS)
-> (LeftCenterRight -> String)
-> ([LeftCenterRight] -> ShowS)
-> Show LeftCenterRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeftCenterRight] -> ShowS
$cshowList :: [LeftCenterRight] -> ShowS
show :: LeftCenterRight -> String
$cshow :: LeftCenterRight -> String
showsPrec :: Int -> LeftCenterRight -> ShowS
$cshowsPrec :: Int -> LeftCenterRight -> ShowS
Show,Eq LeftCenterRight
Eq LeftCenterRight
-> (LeftCenterRight -> LeftCenterRight -> Ordering)
-> (LeftCenterRight -> LeftCenterRight -> Bool)
-> (LeftCenterRight -> LeftCenterRight -> Bool)
-> (LeftCenterRight -> LeftCenterRight -> Bool)
-> (LeftCenterRight -> LeftCenterRight -> Bool)
-> (LeftCenterRight -> LeftCenterRight -> LeftCenterRight)
-> (LeftCenterRight -> LeftCenterRight -> LeftCenterRight)
-> Ord LeftCenterRight
LeftCenterRight -> LeftCenterRight -> Bool
LeftCenterRight -> LeftCenterRight -> Ordering
LeftCenterRight -> LeftCenterRight -> LeftCenterRight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LeftCenterRight -> LeftCenterRight -> LeftCenterRight
$cmin :: LeftCenterRight -> LeftCenterRight -> LeftCenterRight
max :: LeftCenterRight -> LeftCenterRight -> LeftCenterRight
$cmax :: LeftCenterRight -> LeftCenterRight -> LeftCenterRight
>= :: LeftCenterRight -> LeftCenterRight -> Bool
$c>= :: LeftCenterRight -> LeftCenterRight -> Bool
> :: LeftCenterRight -> LeftCenterRight -> Bool
$c> :: LeftCenterRight -> LeftCenterRight -> Bool
<= :: LeftCenterRight -> LeftCenterRight -> Bool
$c<= :: LeftCenterRight -> LeftCenterRight -> Bool
< :: LeftCenterRight -> LeftCenterRight -> Bool
$c< :: LeftCenterRight -> LeftCenterRight -> Bool
compare :: LeftCenterRight -> LeftCenterRight -> Ordering
$ccompare :: LeftCenterRight -> LeftCenterRight -> Ordering
$cp1Ord :: Eq LeftCenterRight
Ord,Int -> LeftCenterRight
LeftCenterRight -> Int
LeftCenterRight -> [LeftCenterRight]
LeftCenterRight -> LeftCenterRight
LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
LeftCenterRight
-> LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
(LeftCenterRight -> LeftCenterRight)
-> (LeftCenterRight -> LeftCenterRight)
-> (Int -> LeftCenterRight)
-> (LeftCenterRight -> Int)
-> (LeftCenterRight -> [LeftCenterRight])
-> (LeftCenterRight -> LeftCenterRight -> [LeftCenterRight])
-> (LeftCenterRight -> LeftCenterRight -> [LeftCenterRight])
-> (LeftCenterRight
    -> LeftCenterRight -> LeftCenterRight -> [LeftCenterRight])
-> Enum LeftCenterRight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LeftCenterRight
-> LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
$cenumFromThenTo :: LeftCenterRight
-> LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
enumFromTo :: LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
$cenumFromTo :: LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
enumFromThen :: LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
$cenumFromThen :: LeftCenterRight -> LeftCenterRight -> [LeftCenterRight]
enumFrom :: LeftCenterRight -> [LeftCenterRight]
$cenumFrom :: LeftCenterRight -> [LeftCenterRight]
fromEnum :: LeftCenterRight -> Int
$cfromEnum :: LeftCenterRight -> Int
toEnum :: Int -> LeftCenterRight
$ctoEnum :: Int -> LeftCenterRight
pred :: LeftCenterRight -> LeftCenterRight
$cpred :: LeftCenterRight -> LeftCenterRight
succ :: LeftCenterRight -> LeftCenterRight
$csucc :: LeftCenterRight -> LeftCenterRight
Enum,LeftCenterRight
LeftCenterRight -> LeftCenterRight -> Bounded LeftCenterRight
forall a. a -> a -> Bounded a
maxBound :: LeftCenterRight
$cmaxBound :: LeftCenterRight
minBound :: LeftCenterRight
$cminBound :: LeftCenterRight
Bounded)
instance EmitXml LeftCenterRight where
    emitXml :: LeftCenterRight -> XmlRep
emitXml LeftCenterRight
LeftCenterRightLeft = String -> XmlRep
XLit String
"left"
    emitXml LeftCenterRight
LeftCenterRightCenter = String -> XmlRep
XLit String
"center"
    emitXml LeftCenterRight
LeftCenterRightRight = String -> XmlRep
XLit String
"right"
parseLeftCenterRight :: String -> P.XParse LeftCenterRight
parseLeftCenterRight :: String -> XParse LeftCenterRight
parseLeftCenterRight String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = LeftCenterRight -> XParse LeftCenterRight
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftCenterRight -> XParse LeftCenterRight)
-> LeftCenterRight -> XParse LeftCenterRight
forall a b. (a -> b) -> a -> b
$ LeftCenterRight
LeftCenterRightLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"center" = LeftCenterRight -> XParse LeftCenterRight
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftCenterRight -> XParse LeftCenterRight)
-> LeftCenterRight -> XParse LeftCenterRight
forall a b. (a -> b) -> a -> b
$ LeftCenterRight
LeftCenterRightCenter
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = LeftCenterRight -> XParse LeftCenterRight
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftCenterRight -> XParse LeftCenterRight)
-> LeftCenterRight -> XParse LeftCenterRight
forall a b. (a -> b) -> a -> b
$ LeftCenterRight
LeftCenterRightRight
        | Bool
otherwise = String -> XParse LeftCenterRight
forall a. String -> XParse a
P.xfail (String -> XParse LeftCenterRight)
-> String -> XParse LeftCenterRight
forall a b. (a -> b) -> a -> b
$ String
"LeftCenterRight: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @left-right@ /(simple)/
--
-- The left-right type is used to indicate whether one element appears to the left or the right of another element.
data LeftRight = 
      LeftRightLeft -- ^ /left/
    | LeftRightRight -- ^ /right/
    deriving (LeftRight -> LeftRight -> Bool
(LeftRight -> LeftRight -> Bool)
-> (LeftRight -> LeftRight -> Bool) -> Eq LeftRight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeftRight -> LeftRight -> Bool
$c/= :: LeftRight -> LeftRight -> Bool
== :: LeftRight -> LeftRight -> Bool
$c== :: LeftRight -> LeftRight -> Bool
Eq,Typeable,(forall x. LeftRight -> Rep LeftRight x)
-> (forall x. Rep LeftRight x -> LeftRight) -> Generic LeftRight
forall x. Rep LeftRight x -> LeftRight
forall x. LeftRight -> Rep LeftRight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LeftRight x -> LeftRight
$cfrom :: forall x. LeftRight -> Rep LeftRight x
Generic,Int -> LeftRight -> ShowS
[LeftRight] -> ShowS
LeftRight -> String
(Int -> LeftRight -> ShowS)
-> (LeftRight -> String)
-> ([LeftRight] -> ShowS)
-> Show LeftRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeftRight] -> ShowS
$cshowList :: [LeftRight] -> ShowS
show :: LeftRight -> String
$cshow :: LeftRight -> String
showsPrec :: Int -> LeftRight -> ShowS
$cshowsPrec :: Int -> LeftRight -> ShowS
Show,Eq LeftRight
Eq LeftRight
-> (LeftRight -> LeftRight -> Ordering)
-> (LeftRight -> LeftRight -> Bool)
-> (LeftRight -> LeftRight -> Bool)
-> (LeftRight -> LeftRight -> Bool)
-> (LeftRight -> LeftRight -> Bool)
-> (LeftRight -> LeftRight -> LeftRight)
-> (LeftRight -> LeftRight -> LeftRight)
-> Ord LeftRight
LeftRight -> LeftRight -> Bool
LeftRight -> LeftRight -> Ordering
LeftRight -> LeftRight -> LeftRight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LeftRight -> LeftRight -> LeftRight
$cmin :: LeftRight -> LeftRight -> LeftRight
max :: LeftRight -> LeftRight -> LeftRight
$cmax :: LeftRight -> LeftRight -> LeftRight
>= :: LeftRight -> LeftRight -> Bool
$c>= :: LeftRight -> LeftRight -> Bool
> :: LeftRight -> LeftRight -> Bool
$c> :: LeftRight -> LeftRight -> Bool
<= :: LeftRight -> LeftRight -> Bool
$c<= :: LeftRight -> LeftRight -> Bool
< :: LeftRight -> LeftRight -> Bool
$c< :: LeftRight -> LeftRight -> Bool
compare :: LeftRight -> LeftRight -> Ordering
$ccompare :: LeftRight -> LeftRight -> Ordering
$cp1Ord :: Eq LeftRight
Ord,Int -> LeftRight
LeftRight -> Int
LeftRight -> [LeftRight]
LeftRight -> LeftRight
LeftRight -> LeftRight -> [LeftRight]
LeftRight -> LeftRight -> LeftRight -> [LeftRight]
(LeftRight -> LeftRight)
-> (LeftRight -> LeftRight)
-> (Int -> LeftRight)
-> (LeftRight -> Int)
-> (LeftRight -> [LeftRight])
-> (LeftRight -> LeftRight -> [LeftRight])
-> (LeftRight -> LeftRight -> [LeftRight])
-> (LeftRight -> LeftRight -> LeftRight -> [LeftRight])
-> Enum LeftRight
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LeftRight -> LeftRight -> LeftRight -> [LeftRight]
$cenumFromThenTo :: LeftRight -> LeftRight -> LeftRight -> [LeftRight]
enumFromTo :: LeftRight -> LeftRight -> [LeftRight]
$cenumFromTo :: LeftRight -> LeftRight -> [LeftRight]
enumFromThen :: LeftRight -> LeftRight -> [LeftRight]
$cenumFromThen :: LeftRight -> LeftRight -> [LeftRight]
enumFrom :: LeftRight -> [LeftRight]
$cenumFrom :: LeftRight -> [LeftRight]
fromEnum :: LeftRight -> Int
$cfromEnum :: LeftRight -> Int
toEnum :: Int -> LeftRight
$ctoEnum :: Int -> LeftRight
pred :: LeftRight -> LeftRight
$cpred :: LeftRight -> LeftRight
succ :: LeftRight -> LeftRight
$csucc :: LeftRight -> LeftRight
Enum,LeftRight
LeftRight -> LeftRight -> Bounded LeftRight
forall a. a -> a -> Bounded a
maxBound :: LeftRight
$cmaxBound :: LeftRight
minBound :: LeftRight
$cminBound :: LeftRight
Bounded)
instance EmitXml LeftRight where
    emitXml :: LeftRight -> XmlRep
emitXml LeftRight
LeftRightLeft = String -> XmlRep
XLit String
"left"
    emitXml LeftRight
LeftRightRight = String -> XmlRep
XLit String
"right"
parseLeftRight :: String -> P.XParse LeftRight
parseLeftRight :: String -> XParse LeftRight
parseLeftRight String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = LeftRight -> XParse LeftRight
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftRight -> XParse LeftRight) -> LeftRight -> XParse LeftRight
forall a b. (a -> b) -> a -> b
$ LeftRight
LeftRightLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = LeftRight -> XParse LeftRight
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftRight -> XParse LeftRight) -> LeftRight -> XParse LeftRight
forall a b. (a -> b) -> a -> b
$ LeftRight
LeftRightRight
        | Bool
otherwise = String -> XParse LeftRight
forall a. String -> XParse a
P.xfail (String -> XParse LeftRight) -> String -> XParse LeftRight
forall a b. (a -> b) -> a -> b
$ String
"LeftRight: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @line-end@ /(simple)/
--
-- The line-end type specifies if there is a jog up or down (or both), an arrow, or nothing at the start or end of a bracket.
data LineEnd = 
      LineEndUp -- ^ /up/
    | LineEndDown -- ^ /down/
    | LineEndBoth -- ^ /both/
    | LineEndArrow -- ^ /arrow/
    | LineEndNone -- ^ /none/
    deriving (LineEnd -> LineEnd -> Bool
(LineEnd -> LineEnd -> Bool)
-> (LineEnd -> LineEnd -> Bool) -> Eq LineEnd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineEnd -> LineEnd -> Bool
$c/= :: LineEnd -> LineEnd -> Bool
== :: LineEnd -> LineEnd -> Bool
$c== :: LineEnd -> LineEnd -> Bool
Eq,Typeable,(forall x. LineEnd -> Rep LineEnd x)
-> (forall x. Rep LineEnd x -> LineEnd) -> Generic LineEnd
forall x. Rep LineEnd x -> LineEnd
forall x. LineEnd -> Rep LineEnd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineEnd x -> LineEnd
$cfrom :: forall x. LineEnd -> Rep LineEnd x
Generic,Int -> LineEnd -> ShowS
[LineEnd] -> ShowS
LineEnd -> String
(Int -> LineEnd -> ShowS)
-> (LineEnd -> String) -> ([LineEnd] -> ShowS) -> Show LineEnd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineEnd] -> ShowS
$cshowList :: [LineEnd] -> ShowS
show :: LineEnd -> String
$cshow :: LineEnd -> String
showsPrec :: Int -> LineEnd -> ShowS
$cshowsPrec :: Int -> LineEnd -> ShowS
Show,Eq LineEnd
Eq LineEnd
-> (LineEnd -> LineEnd -> Ordering)
-> (LineEnd -> LineEnd -> Bool)
-> (LineEnd -> LineEnd -> Bool)
-> (LineEnd -> LineEnd -> Bool)
-> (LineEnd -> LineEnd -> Bool)
-> (LineEnd -> LineEnd -> LineEnd)
-> (LineEnd -> LineEnd -> LineEnd)
-> Ord LineEnd
LineEnd -> LineEnd -> Bool
LineEnd -> LineEnd -> Ordering
LineEnd -> LineEnd -> LineEnd
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineEnd -> LineEnd -> LineEnd
$cmin :: LineEnd -> LineEnd -> LineEnd
max :: LineEnd -> LineEnd -> LineEnd
$cmax :: LineEnd -> LineEnd -> LineEnd
>= :: LineEnd -> LineEnd -> Bool
$c>= :: LineEnd -> LineEnd -> Bool
> :: LineEnd -> LineEnd -> Bool
$c> :: LineEnd -> LineEnd -> Bool
<= :: LineEnd -> LineEnd -> Bool
$c<= :: LineEnd -> LineEnd -> Bool
< :: LineEnd -> LineEnd -> Bool
$c< :: LineEnd -> LineEnd -> Bool
compare :: LineEnd -> LineEnd -> Ordering
$ccompare :: LineEnd -> LineEnd -> Ordering
$cp1Ord :: Eq LineEnd
Ord,Int -> LineEnd
LineEnd -> Int
LineEnd -> [LineEnd]
LineEnd -> LineEnd
LineEnd -> LineEnd -> [LineEnd]
LineEnd -> LineEnd -> LineEnd -> [LineEnd]
(LineEnd -> LineEnd)
-> (LineEnd -> LineEnd)
-> (Int -> LineEnd)
-> (LineEnd -> Int)
-> (LineEnd -> [LineEnd])
-> (LineEnd -> LineEnd -> [LineEnd])
-> (LineEnd -> LineEnd -> [LineEnd])
-> (LineEnd -> LineEnd -> LineEnd -> [LineEnd])
-> Enum LineEnd
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LineEnd -> LineEnd -> LineEnd -> [LineEnd]
$cenumFromThenTo :: LineEnd -> LineEnd -> LineEnd -> [LineEnd]
enumFromTo :: LineEnd -> LineEnd -> [LineEnd]
$cenumFromTo :: LineEnd -> LineEnd -> [LineEnd]
enumFromThen :: LineEnd -> LineEnd -> [LineEnd]
$cenumFromThen :: LineEnd -> LineEnd -> [LineEnd]
enumFrom :: LineEnd -> [LineEnd]
$cenumFrom :: LineEnd -> [LineEnd]
fromEnum :: LineEnd -> Int
$cfromEnum :: LineEnd -> Int
toEnum :: Int -> LineEnd
$ctoEnum :: Int -> LineEnd
pred :: LineEnd -> LineEnd
$cpred :: LineEnd -> LineEnd
succ :: LineEnd -> LineEnd
$csucc :: LineEnd -> LineEnd
Enum,LineEnd
LineEnd -> LineEnd -> Bounded LineEnd
forall a. a -> a -> Bounded a
maxBound :: LineEnd
$cmaxBound :: LineEnd
minBound :: LineEnd
$cminBound :: LineEnd
Bounded)
instance EmitXml LineEnd where
    emitXml :: LineEnd -> XmlRep
emitXml LineEnd
LineEndUp = String -> XmlRep
XLit String
"up"
    emitXml LineEnd
LineEndDown = String -> XmlRep
XLit String
"down"
    emitXml LineEnd
LineEndBoth = String -> XmlRep
XLit String
"both"
    emitXml LineEnd
LineEndArrow = String -> XmlRep
XLit String
"arrow"
    emitXml LineEnd
LineEndNone = String -> XmlRep
XLit String
"none"
parseLineEnd :: String -> P.XParse LineEnd
parseLineEnd :: String -> XParse LineEnd
parseLineEnd String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = LineEnd -> XParse LineEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (LineEnd -> XParse LineEnd) -> LineEnd -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ LineEnd
LineEndUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = LineEnd -> XParse LineEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (LineEnd -> XParse LineEnd) -> LineEnd -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ LineEnd
LineEndDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"both" = LineEnd -> XParse LineEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (LineEnd -> XParse LineEnd) -> LineEnd -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ LineEnd
LineEndBoth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arrow" = LineEnd -> XParse LineEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (LineEnd -> XParse LineEnd) -> LineEnd -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ LineEnd
LineEndArrow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = LineEnd -> XParse LineEnd
forall (m :: * -> *) a. Monad m => a -> m a
return (LineEnd -> XParse LineEnd) -> LineEnd -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ LineEnd
LineEndNone
        | Bool
otherwise = String -> XParse LineEnd
forall a. String -> XParse a
P.xfail (String -> XParse LineEnd) -> String -> XParse LineEnd
forall a b. (a -> b) -> a -> b
$ String
"LineEnd: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @line-length@ /(simple)/
--
-- The line-length type distinguishes between different line lengths for doit, falloff, plop, and scoop articulations.
data LineLength = 
      LineLengthShort -- ^ /short/
    | LineLengthMedium -- ^ /medium/
    | LineLengthLong -- ^ /long/
    deriving (LineLength -> LineLength -> Bool
(LineLength -> LineLength -> Bool)
-> (LineLength -> LineLength -> Bool) -> Eq LineLength
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineLength -> LineLength -> Bool
$c/= :: LineLength -> LineLength -> Bool
== :: LineLength -> LineLength -> Bool
$c== :: LineLength -> LineLength -> Bool
Eq,Typeable,(forall x. LineLength -> Rep LineLength x)
-> (forall x. Rep LineLength x -> LineLength) -> Generic LineLength
forall x. Rep LineLength x -> LineLength
forall x. LineLength -> Rep LineLength x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineLength x -> LineLength
$cfrom :: forall x. LineLength -> Rep LineLength x
Generic,Int -> LineLength -> ShowS
[LineLength] -> ShowS
LineLength -> String
(Int -> LineLength -> ShowS)
-> (LineLength -> String)
-> ([LineLength] -> ShowS)
-> Show LineLength
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineLength] -> ShowS
$cshowList :: [LineLength] -> ShowS
show :: LineLength -> String
$cshow :: LineLength -> String
showsPrec :: Int -> LineLength -> ShowS
$cshowsPrec :: Int -> LineLength -> ShowS
Show,Eq LineLength
Eq LineLength
-> (LineLength -> LineLength -> Ordering)
-> (LineLength -> LineLength -> Bool)
-> (LineLength -> LineLength -> Bool)
-> (LineLength -> LineLength -> Bool)
-> (LineLength -> LineLength -> Bool)
-> (LineLength -> LineLength -> LineLength)
-> (LineLength -> LineLength -> LineLength)
-> Ord LineLength
LineLength -> LineLength -> Bool
LineLength -> LineLength -> Ordering
LineLength -> LineLength -> LineLength
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineLength -> LineLength -> LineLength
$cmin :: LineLength -> LineLength -> LineLength
max :: LineLength -> LineLength -> LineLength
$cmax :: LineLength -> LineLength -> LineLength
>= :: LineLength -> LineLength -> Bool
$c>= :: LineLength -> LineLength -> Bool
> :: LineLength -> LineLength -> Bool
$c> :: LineLength -> LineLength -> Bool
<= :: LineLength -> LineLength -> Bool
$c<= :: LineLength -> LineLength -> Bool
< :: LineLength -> LineLength -> Bool
$c< :: LineLength -> LineLength -> Bool
compare :: LineLength -> LineLength -> Ordering
$ccompare :: LineLength -> LineLength -> Ordering
$cp1Ord :: Eq LineLength
Ord,Int -> LineLength
LineLength -> Int
LineLength -> [LineLength]
LineLength -> LineLength
LineLength -> LineLength -> [LineLength]
LineLength -> LineLength -> LineLength -> [LineLength]
(LineLength -> LineLength)
-> (LineLength -> LineLength)
-> (Int -> LineLength)
-> (LineLength -> Int)
-> (LineLength -> [LineLength])
-> (LineLength -> LineLength -> [LineLength])
-> (LineLength -> LineLength -> [LineLength])
-> (LineLength -> LineLength -> LineLength -> [LineLength])
-> Enum LineLength
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LineLength -> LineLength -> LineLength -> [LineLength]
$cenumFromThenTo :: LineLength -> LineLength -> LineLength -> [LineLength]
enumFromTo :: LineLength -> LineLength -> [LineLength]
$cenumFromTo :: LineLength -> LineLength -> [LineLength]
enumFromThen :: LineLength -> LineLength -> [LineLength]
$cenumFromThen :: LineLength -> LineLength -> [LineLength]
enumFrom :: LineLength -> [LineLength]
$cenumFrom :: LineLength -> [LineLength]
fromEnum :: LineLength -> Int
$cfromEnum :: LineLength -> Int
toEnum :: Int -> LineLength
$ctoEnum :: Int -> LineLength
pred :: LineLength -> LineLength
$cpred :: LineLength -> LineLength
succ :: LineLength -> LineLength
$csucc :: LineLength -> LineLength
Enum,LineLength
LineLength -> LineLength -> Bounded LineLength
forall a. a -> a -> Bounded a
maxBound :: LineLength
$cmaxBound :: LineLength
minBound :: LineLength
$cminBound :: LineLength
Bounded)
instance EmitXml LineLength where
    emitXml :: LineLength -> XmlRep
emitXml LineLength
LineLengthShort = String -> XmlRep
XLit String
"short"
    emitXml LineLength
LineLengthMedium = String -> XmlRep
XLit String
"medium"
    emitXml LineLength
LineLengthLong = String -> XmlRep
XLit String
"long"
parseLineLength :: String -> P.XParse LineLength
parseLineLength :: String -> XParse LineLength
parseLineLength String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"short" = LineLength -> XParse LineLength
forall (m :: * -> *) a. Monad m => a -> m a
return (LineLength -> XParse LineLength)
-> LineLength -> XParse LineLength
forall a b. (a -> b) -> a -> b
$ LineLength
LineLengthShort
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium" = LineLength -> XParse LineLength
forall (m :: * -> *) a. Monad m => a -> m a
return (LineLength -> XParse LineLength)
-> LineLength -> XParse LineLength
forall a b. (a -> b) -> a -> b
$ LineLength
LineLengthMedium
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"long" = LineLength -> XParse LineLength
forall (m :: * -> *) a. Monad m => a -> m a
return (LineLength -> XParse LineLength)
-> LineLength -> XParse LineLength
forall a b. (a -> b) -> a -> b
$ LineLength
LineLengthLong
        | Bool
otherwise = String -> XParse LineLength
forall a. String -> XParse a
P.xfail (String -> XParse LineLength) -> String -> XParse LineLength
forall a b. (a -> b) -> a -> b
$ String
"LineLength: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @line-shape@ /(simple)/
--
-- The line-shape type distinguishes between straight and curved lines.
data LineShape = 
      LineShapeStraight -- ^ /straight/
    | LineShapeCurved -- ^ /curved/
    deriving (LineShape -> LineShape -> Bool
(LineShape -> LineShape -> Bool)
-> (LineShape -> LineShape -> Bool) -> Eq LineShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineShape -> LineShape -> Bool
$c/= :: LineShape -> LineShape -> Bool
== :: LineShape -> LineShape -> Bool
$c== :: LineShape -> LineShape -> Bool
Eq,Typeable,(forall x. LineShape -> Rep LineShape x)
-> (forall x. Rep LineShape x -> LineShape) -> Generic LineShape
forall x. Rep LineShape x -> LineShape
forall x. LineShape -> Rep LineShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineShape x -> LineShape
$cfrom :: forall x. LineShape -> Rep LineShape x
Generic,Int -> LineShape -> ShowS
[LineShape] -> ShowS
LineShape -> String
(Int -> LineShape -> ShowS)
-> (LineShape -> String)
-> ([LineShape] -> ShowS)
-> Show LineShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineShape] -> ShowS
$cshowList :: [LineShape] -> ShowS
show :: LineShape -> String
$cshow :: LineShape -> String
showsPrec :: Int -> LineShape -> ShowS
$cshowsPrec :: Int -> LineShape -> ShowS
Show,Eq LineShape
Eq LineShape
-> (LineShape -> LineShape -> Ordering)
-> (LineShape -> LineShape -> Bool)
-> (LineShape -> LineShape -> Bool)
-> (LineShape -> LineShape -> Bool)
-> (LineShape -> LineShape -> Bool)
-> (LineShape -> LineShape -> LineShape)
-> (LineShape -> LineShape -> LineShape)
-> Ord LineShape
LineShape -> LineShape -> Bool
LineShape -> LineShape -> Ordering
LineShape -> LineShape -> LineShape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineShape -> LineShape -> LineShape
$cmin :: LineShape -> LineShape -> LineShape
max :: LineShape -> LineShape -> LineShape
$cmax :: LineShape -> LineShape -> LineShape
>= :: LineShape -> LineShape -> Bool
$c>= :: LineShape -> LineShape -> Bool
> :: LineShape -> LineShape -> Bool
$c> :: LineShape -> LineShape -> Bool
<= :: LineShape -> LineShape -> Bool
$c<= :: LineShape -> LineShape -> Bool
< :: LineShape -> LineShape -> Bool
$c< :: LineShape -> LineShape -> Bool
compare :: LineShape -> LineShape -> Ordering
$ccompare :: LineShape -> LineShape -> Ordering
$cp1Ord :: Eq LineShape
Ord,Int -> LineShape
LineShape -> Int
LineShape -> [LineShape]
LineShape -> LineShape
LineShape -> LineShape -> [LineShape]
LineShape -> LineShape -> LineShape -> [LineShape]
(LineShape -> LineShape)
-> (LineShape -> LineShape)
-> (Int -> LineShape)
-> (LineShape -> Int)
-> (LineShape -> [LineShape])
-> (LineShape -> LineShape -> [LineShape])
-> (LineShape -> LineShape -> [LineShape])
-> (LineShape -> LineShape -> LineShape -> [LineShape])
-> Enum LineShape
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LineShape -> LineShape -> LineShape -> [LineShape]
$cenumFromThenTo :: LineShape -> LineShape -> LineShape -> [LineShape]
enumFromTo :: LineShape -> LineShape -> [LineShape]
$cenumFromTo :: LineShape -> LineShape -> [LineShape]
enumFromThen :: LineShape -> LineShape -> [LineShape]
$cenumFromThen :: LineShape -> LineShape -> [LineShape]
enumFrom :: LineShape -> [LineShape]
$cenumFrom :: LineShape -> [LineShape]
fromEnum :: LineShape -> Int
$cfromEnum :: LineShape -> Int
toEnum :: Int -> LineShape
$ctoEnum :: Int -> LineShape
pred :: LineShape -> LineShape
$cpred :: LineShape -> LineShape
succ :: LineShape -> LineShape
$csucc :: LineShape -> LineShape
Enum,LineShape
LineShape -> LineShape -> Bounded LineShape
forall a. a -> a -> Bounded a
maxBound :: LineShape
$cmaxBound :: LineShape
minBound :: LineShape
$cminBound :: LineShape
Bounded)
instance EmitXml LineShape where
    emitXml :: LineShape -> XmlRep
emitXml LineShape
LineShapeStraight = String -> XmlRep
XLit String
"straight"
    emitXml LineShape
LineShapeCurved = String -> XmlRep
XLit String
"curved"
parseLineShape :: String -> P.XParse LineShape
parseLineShape :: String -> XParse LineShape
parseLineShape String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"straight" = LineShape -> XParse LineShape
forall (m :: * -> *) a. Monad m => a -> m a
return (LineShape -> XParse LineShape) -> LineShape -> XParse LineShape
forall a b. (a -> b) -> a -> b
$ LineShape
LineShapeStraight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"curved" = LineShape -> XParse LineShape
forall (m :: * -> *) a. Monad m => a -> m a
return (LineShape -> XParse LineShape) -> LineShape -> XParse LineShape
forall a b. (a -> b) -> a -> b
$ LineShape
LineShapeCurved
        | Bool
otherwise = String -> XParse LineShape
forall a. String -> XParse a
P.xfail (String -> XParse LineShape) -> String -> XParse LineShape
forall a b. (a -> b) -> a -> b
$ String
"LineShape: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @line-type@ /(simple)/
--
-- The line-type type distinguishes between solid, dashed, dotted, and wavy lines.
data LineType = 
      LineTypeSolid -- ^ /solid/
    | LineTypeDashed -- ^ /dashed/
    | LineTypeDotted -- ^ /dotted/
    | LineTypeWavy -- ^ /wavy/
    deriving (LineType -> LineType -> Bool
(LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool) -> Eq LineType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineType -> LineType -> Bool
$c/= :: LineType -> LineType -> Bool
== :: LineType -> LineType -> Bool
$c== :: LineType -> LineType -> Bool
Eq,Typeable,(forall x. LineType -> Rep LineType x)
-> (forall x. Rep LineType x -> LineType) -> Generic LineType
forall x. Rep LineType x -> LineType
forall x. LineType -> Rep LineType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineType x -> LineType
$cfrom :: forall x. LineType -> Rep LineType x
Generic,Int -> LineType -> ShowS
[LineType] -> ShowS
LineType -> String
(Int -> LineType -> ShowS)
-> (LineType -> String) -> ([LineType] -> ShowS) -> Show LineType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineType] -> ShowS
$cshowList :: [LineType] -> ShowS
show :: LineType -> String
$cshow :: LineType -> String
showsPrec :: Int -> LineType -> ShowS
$cshowsPrec :: Int -> LineType -> ShowS
Show,Eq LineType
Eq LineType
-> (LineType -> LineType -> Ordering)
-> (LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool)
-> (LineType -> LineType -> LineType)
-> (LineType -> LineType -> LineType)
-> Ord LineType
LineType -> LineType -> Bool
LineType -> LineType -> Ordering
LineType -> LineType -> LineType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineType -> LineType -> LineType
$cmin :: LineType -> LineType -> LineType
max :: LineType -> LineType -> LineType
$cmax :: LineType -> LineType -> LineType
>= :: LineType -> LineType -> Bool
$c>= :: LineType -> LineType -> Bool
> :: LineType -> LineType -> Bool
$c> :: LineType -> LineType -> Bool
<= :: LineType -> LineType -> Bool
$c<= :: LineType -> LineType -> Bool
< :: LineType -> LineType -> Bool
$c< :: LineType -> LineType -> Bool
compare :: LineType -> LineType -> Ordering
$ccompare :: LineType -> LineType -> Ordering
$cp1Ord :: Eq LineType
Ord,Int -> LineType
LineType -> Int
LineType -> [LineType]
LineType -> LineType
LineType -> LineType -> [LineType]
LineType -> LineType -> LineType -> [LineType]
(LineType -> LineType)
-> (LineType -> LineType)
-> (Int -> LineType)
-> (LineType -> Int)
-> (LineType -> [LineType])
-> (LineType -> LineType -> [LineType])
-> (LineType -> LineType -> [LineType])
-> (LineType -> LineType -> LineType -> [LineType])
-> Enum LineType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LineType -> LineType -> LineType -> [LineType]
$cenumFromThenTo :: LineType -> LineType -> LineType -> [LineType]
enumFromTo :: LineType -> LineType -> [LineType]
$cenumFromTo :: LineType -> LineType -> [LineType]
enumFromThen :: LineType -> LineType -> [LineType]
$cenumFromThen :: LineType -> LineType -> [LineType]
enumFrom :: LineType -> [LineType]
$cenumFrom :: LineType -> [LineType]
fromEnum :: LineType -> Int
$cfromEnum :: LineType -> Int
toEnum :: Int -> LineType
$ctoEnum :: Int -> LineType
pred :: LineType -> LineType
$cpred :: LineType -> LineType
succ :: LineType -> LineType
$csucc :: LineType -> LineType
Enum,LineType
LineType -> LineType -> Bounded LineType
forall a. a -> a -> Bounded a
maxBound :: LineType
$cmaxBound :: LineType
minBound :: LineType
$cminBound :: LineType
Bounded)
instance EmitXml LineType where
    emitXml :: LineType -> XmlRep
emitXml LineType
LineTypeSolid = String -> XmlRep
XLit String
"solid"
    emitXml LineType
LineTypeDashed = String -> XmlRep
XLit String
"dashed"
    emitXml LineType
LineTypeDotted = String -> XmlRep
XLit String
"dotted"
    emitXml LineType
LineTypeWavy = String -> XmlRep
XLit String
"wavy"
parseLineType :: String -> P.XParse LineType
parseLineType :: String -> XParse LineType
parseLineType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"solid" = LineType -> XParse LineType
forall (m :: * -> *) a. Monad m => a -> m a
return (LineType -> XParse LineType) -> LineType -> XParse LineType
forall a b. (a -> b) -> a -> b
$ LineType
LineTypeSolid
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dashed" = LineType -> XParse LineType
forall (m :: * -> *) a. Monad m => a -> m a
return (LineType -> XParse LineType) -> LineType -> XParse LineType
forall a b. (a -> b) -> a -> b
$ LineType
LineTypeDashed
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dotted" = LineType -> XParse LineType
forall (m :: * -> *) a. Monad m => a -> m a
return (LineType -> XParse LineType) -> LineType -> XParse LineType
forall a b. (a -> b) -> a -> b
$ LineType
LineTypeDotted
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wavy" = LineType -> XParse LineType
forall (m :: * -> *) a. Monad m => a -> m a
return (LineType -> XParse LineType) -> LineType -> XParse LineType
forall a b. (a -> b) -> a -> b
$ LineType
LineTypeWavy
        | Bool
otherwise = String -> XParse LineType
forall a. String -> XParse a
P.xfail (String -> XParse LineType) -> String -> XParse LineType
forall a b. (a -> b) -> a -> b
$ String
"LineType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @line-width-type@ /(simple)/
--
-- The line-width-type defines what type of line is being defined in a line-width element. Values include beam, bracket, dashes, enclosure, ending, extend, heavy barline, leger, light barline, octave shift, pedal, slur middle, slur tip, staff, stem, tie middle, tie tip, tuplet bracket, and wedge. This is left as a string so that other application-specific types can be defined, but it is made a separate type so that it can be redefined more strictly.
newtype LineWidthType = LineWidthType { LineWidthType -> Token
lineWidthType :: Token }
    deriving (LineWidthType -> LineWidthType -> Bool
(LineWidthType -> LineWidthType -> Bool)
-> (LineWidthType -> LineWidthType -> Bool) -> Eq LineWidthType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineWidthType -> LineWidthType -> Bool
$c/= :: LineWidthType -> LineWidthType -> Bool
== :: LineWidthType -> LineWidthType -> Bool
$c== :: LineWidthType -> LineWidthType -> Bool
Eq,Typeable,(forall x. LineWidthType -> Rep LineWidthType x)
-> (forall x. Rep LineWidthType x -> LineWidthType)
-> Generic LineWidthType
forall x. Rep LineWidthType x -> LineWidthType
forall x. LineWidthType -> Rep LineWidthType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineWidthType x -> LineWidthType
$cfrom :: forall x. LineWidthType -> Rep LineWidthType x
Generic,Eq LineWidthType
Eq LineWidthType
-> (LineWidthType -> LineWidthType -> Ordering)
-> (LineWidthType -> LineWidthType -> Bool)
-> (LineWidthType -> LineWidthType -> Bool)
-> (LineWidthType -> LineWidthType -> Bool)
-> (LineWidthType -> LineWidthType -> Bool)
-> (LineWidthType -> LineWidthType -> LineWidthType)
-> (LineWidthType -> LineWidthType -> LineWidthType)
-> Ord LineWidthType
LineWidthType -> LineWidthType -> Bool
LineWidthType -> LineWidthType -> Ordering
LineWidthType -> LineWidthType -> LineWidthType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineWidthType -> LineWidthType -> LineWidthType
$cmin :: LineWidthType -> LineWidthType -> LineWidthType
max :: LineWidthType -> LineWidthType -> LineWidthType
$cmax :: LineWidthType -> LineWidthType -> LineWidthType
>= :: LineWidthType -> LineWidthType -> Bool
$c>= :: LineWidthType -> LineWidthType -> Bool
> :: LineWidthType -> LineWidthType -> Bool
$c> :: LineWidthType -> LineWidthType -> Bool
<= :: LineWidthType -> LineWidthType -> Bool
$c<= :: LineWidthType -> LineWidthType -> Bool
< :: LineWidthType -> LineWidthType -> Bool
$c< :: LineWidthType -> LineWidthType -> Bool
compare :: LineWidthType -> LineWidthType -> Ordering
$ccompare :: LineWidthType -> LineWidthType -> Ordering
$cp1Ord :: Eq LineWidthType
Ord,String -> LineWidthType
(String -> LineWidthType) -> IsString LineWidthType
forall a. (String -> a) -> IsString a
fromString :: String -> LineWidthType
$cfromString :: String -> LineWidthType
IsString)
instance Show LineWidthType where show :: LineWidthType -> String
show (LineWidthType Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read LineWidthType where readsPrec :: Int -> ReadS LineWidthType
readsPrec Int
i = ((Token, String) -> (LineWidthType, String))
-> [(Token, String)] -> [(LineWidthType, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> LineWidthType)
-> (Token, String) -> (LineWidthType, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> LineWidthType
LineWidthType) ([(Token, String)] -> [(LineWidthType, String)])
-> (String -> [(Token, String)]) -> ReadS LineWidthType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml LineWidthType where
    emitXml :: LineWidthType -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep)
-> (LineWidthType -> Token) -> LineWidthType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineWidthType -> Token
lineWidthType
parseLineWidthType :: String -> P.XParse LineWidthType
parseLineWidthType :: String -> XParse LineWidthType
parseLineWidthType = LineWidthType -> XParse LineWidthType
forall (m :: * -> *) a. Monad m => a -> m a
return (LineWidthType -> XParse LineWidthType)
-> (String -> LineWidthType) -> String -> XParse LineWidthType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> LineWidthType
forall a. IsString a => String -> a
fromString

-- | @margin-type@ /(simple)/
--
-- The margin-type type specifies whether margins apply to even page, odd pages, or both.
data MarginType = 
      MarginTypeOdd -- ^ /odd/
    | MarginTypeEven -- ^ /even/
    | MarginTypeBoth -- ^ /both/
    deriving (MarginType -> MarginType -> Bool
(MarginType -> MarginType -> Bool)
-> (MarginType -> MarginType -> Bool) -> Eq MarginType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarginType -> MarginType -> Bool
$c/= :: MarginType -> MarginType -> Bool
== :: MarginType -> MarginType -> Bool
$c== :: MarginType -> MarginType -> Bool
Eq,Typeable,(forall x. MarginType -> Rep MarginType x)
-> (forall x. Rep MarginType x -> MarginType) -> Generic MarginType
forall x. Rep MarginType x -> MarginType
forall x. MarginType -> Rep MarginType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MarginType x -> MarginType
$cfrom :: forall x. MarginType -> Rep MarginType x
Generic,Int -> MarginType -> ShowS
[MarginType] -> ShowS
MarginType -> String
(Int -> MarginType -> ShowS)
-> (MarginType -> String)
-> ([MarginType] -> ShowS)
-> Show MarginType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarginType] -> ShowS
$cshowList :: [MarginType] -> ShowS
show :: MarginType -> String
$cshow :: MarginType -> String
showsPrec :: Int -> MarginType -> ShowS
$cshowsPrec :: Int -> MarginType -> ShowS
Show,Eq MarginType
Eq MarginType
-> (MarginType -> MarginType -> Ordering)
-> (MarginType -> MarginType -> Bool)
-> (MarginType -> MarginType -> Bool)
-> (MarginType -> MarginType -> Bool)
-> (MarginType -> MarginType -> Bool)
-> (MarginType -> MarginType -> MarginType)
-> (MarginType -> MarginType -> MarginType)
-> Ord MarginType
MarginType -> MarginType -> Bool
MarginType -> MarginType -> Ordering
MarginType -> MarginType -> MarginType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MarginType -> MarginType -> MarginType
$cmin :: MarginType -> MarginType -> MarginType
max :: MarginType -> MarginType -> MarginType
$cmax :: MarginType -> MarginType -> MarginType
>= :: MarginType -> MarginType -> Bool
$c>= :: MarginType -> MarginType -> Bool
> :: MarginType -> MarginType -> Bool
$c> :: MarginType -> MarginType -> Bool
<= :: MarginType -> MarginType -> Bool
$c<= :: MarginType -> MarginType -> Bool
< :: MarginType -> MarginType -> Bool
$c< :: MarginType -> MarginType -> Bool
compare :: MarginType -> MarginType -> Ordering
$ccompare :: MarginType -> MarginType -> Ordering
$cp1Ord :: Eq MarginType
Ord,Int -> MarginType
MarginType -> Int
MarginType -> [MarginType]
MarginType -> MarginType
MarginType -> MarginType -> [MarginType]
MarginType -> MarginType -> MarginType -> [MarginType]
(MarginType -> MarginType)
-> (MarginType -> MarginType)
-> (Int -> MarginType)
-> (MarginType -> Int)
-> (MarginType -> [MarginType])
-> (MarginType -> MarginType -> [MarginType])
-> (MarginType -> MarginType -> [MarginType])
-> (MarginType -> MarginType -> MarginType -> [MarginType])
-> Enum MarginType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MarginType -> MarginType -> MarginType -> [MarginType]
$cenumFromThenTo :: MarginType -> MarginType -> MarginType -> [MarginType]
enumFromTo :: MarginType -> MarginType -> [MarginType]
$cenumFromTo :: MarginType -> MarginType -> [MarginType]
enumFromThen :: MarginType -> MarginType -> [MarginType]
$cenumFromThen :: MarginType -> MarginType -> [MarginType]
enumFrom :: MarginType -> [MarginType]
$cenumFrom :: MarginType -> [MarginType]
fromEnum :: MarginType -> Int
$cfromEnum :: MarginType -> Int
toEnum :: Int -> MarginType
$ctoEnum :: Int -> MarginType
pred :: MarginType -> MarginType
$cpred :: MarginType -> MarginType
succ :: MarginType -> MarginType
$csucc :: MarginType -> MarginType
Enum,MarginType
MarginType -> MarginType -> Bounded MarginType
forall a. a -> a -> Bounded a
maxBound :: MarginType
$cmaxBound :: MarginType
minBound :: MarginType
$cminBound :: MarginType
Bounded)
instance EmitXml MarginType where
    emitXml :: MarginType -> XmlRep
emitXml MarginType
MarginTypeOdd = String -> XmlRep
XLit String
"odd"
    emitXml MarginType
MarginTypeEven = String -> XmlRep
XLit String
"even"
    emitXml MarginType
MarginTypeBoth = String -> XmlRep
XLit String
"both"
parseMarginType :: String -> P.XParse MarginType
parseMarginType :: String -> XParse MarginType
parseMarginType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"odd" = MarginType -> XParse MarginType
forall (m :: * -> *) a. Monad m => a -> m a
return (MarginType -> XParse MarginType)
-> MarginType -> XParse MarginType
forall a b. (a -> b) -> a -> b
$ MarginType
MarginTypeOdd
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"even" = MarginType -> XParse MarginType
forall (m :: * -> *) a. Monad m => a -> m a
return (MarginType -> XParse MarginType)
-> MarginType -> XParse MarginType
forall a b. (a -> b) -> a -> b
$ MarginType
MarginTypeEven
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"both" = MarginType -> XParse MarginType
forall (m :: * -> *) a. Monad m => a -> m a
return (MarginType -> XParse MarginType)
-> MarginType -> XParse MarginType
forall a b. (a -> b) -> a -> b
$ MarginType
MarginTypeBoth
        | Bool
otherwise = String -> XParse MarginType
forall a. String -> XParse a
P.xfail (String -> XParse MarginType) -> String -> XParse MarginType
forall a b. (a -> b) -> a -> b
$ String
"MarginType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @measure-numbering-value@ /(simple)/
--
-- The measure-numbering-value type describes how measure numbers are displayed on this part: no numbers, numbers every measure, or numbers every system.
data MeasureNumberingValue = 
      MeasureNumberingValueNone -- ^ /none/
    | MeasureNumberingValueMeasure -- ^ /measure/
    | MeasureNumberingValueSystem -- ^ /system/
    deriving (MeasureNumberingValue -> MeasureNumberingValue -> Bool
(MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> (MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> Eq MeasureNumberingValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c/= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
== :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c== :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
Eq,Typeable,(forall x. MeasureNumberingValue -> Rep MeasureNumberingValue x)
-> (forall x. Rep MeasureNumberingValue x -> MeasureNumberingValue)
-> Generic MeasureNumberingValue
forall x. Rep MeasureNumberingValue x -> MeasureNumberingValue
forall x. MeasureNumberingValue -> Rep MeasureNumberingValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureNumberingValue x -> MeasureNumberingValue
$cfrom :: forall x. MeasureNumberingValue -> Rep MeasureNumberingValue x
Generic,Int -> MeasureNumberingValue -> ShowS
[MeasureNumberingValue] -> ShowS
MeasureNumberingValue -> String
(Int -> MeasureNumberingValue -> ShowS)
-> (MeasureNumberingValue -> String)
-> ([MeasureNumberingValue] -> ShowS)
-> Show MeasureNumberingValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasureNumberingValue] -> ShowS
$cshowList :: [MeasureNumberingValue] -> ShowS
show :: MeasureNumberingValue -> String
$cshow :: MeasureNumberingValue -> String
showsPrec :: Int -> MeasureNumberingValue -> ShowS
$cshowsPrec :: Int -> MeasureNumberingValue -> ShowS
Show,Eq MeasureNumberingValue
Eq MeasureNumberingValue
-> (MeasureNumberingValue -> MeasureNumberingValue -> Ordering)
-> (MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> (MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> (MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> (MeasureNumberingValue -> MeasureNumberingValue -> Bool)
-> (MeasureNumberingValue
    -> MeasureNumberingValue -> MeasureNumberingValue)
-> (MeasureNumberingValue
    -> MeasureNumberingValue -> MeasureNumberingValue)
-> Ord MeasureNumberingValue
MeasureNumberingValue -> MeasureNumberingValue -> Bool
MeasureNumberingValue -> MeasureNumberingValue -> Ordering
MeasureNumberingValue
-> MeasureNumberingValue -> MeasureNumberingValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MeasureNumberingValue
-> MeasureNumberingValue -> MeasureNumberingValue
$cmin :: MeasureNumberingValue
-> MeasureNumberingValue -> MeasureNumberingValue
max :: MeasureNumberingValue
-> MeasureNumberingValue -> MeasureNumberingValue
$cmax :: MeasureNumberingValue
-> MeasureNumberingValue -> MeasureNumberingValue
>= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c>= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
> :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c> :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
<= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c<= :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
< :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
$c< :: MeasureNumberingValue -> MeasureNumberingValue -> Bool
compare :: MeasureNumberingValue -> MeasureNumberingValue -> Ordering
$ccompare :: MeasureNumberingValue -> MeasureNumberingValue -> Ordering
$cp1Ord :: Eq MeasureNumberingValue
Ord,Int -> MeasureNumberingValue
MeasureNumberingValue -> Int
MeasureNumberingValue -> [MeasureNumberingValue]
MeasureNumberingValue -> MeasureNumberingValue
MeasureNumberingValue
-> MeasureNumberingValue -> [MeasureNumberingValue]
MeasureNumberingValue
-> MeasureNumberingValue
-> MeasureNumberingValue
-> [MeasureNumberingValue]
(MeasureNumberingValue -> MeasureNumberingValue)
-> (MeasureNumberingValue -> MeasureNumberingValue)
-> (Int -> MeasureNumberingValue)
-> (MeasureNumberingValue -> Int)
-> (MeasureNumberingValue -> [MeasureNumberingValue])
-> (MeasureNumberingValue
    -> MeasureNumberingValue -> [MeasureNumberingValue])
-> (MeasureNumberingValue
    -> MeasureNumberingValue -> [MeasureNumberingValue])
-> (MeasureNumberingValue
    -> MeasureNumberingValue
    -> MeasureNumberingValue
    -> [MeasureNumberingValue])
-> Enum MeasureNumberingValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MeasureNumberingValue
-> MeasureNumberingValue
-> MeasureNumberingValue
-> [MeasureNumberingValue]
$cenumFromThenTo :: MeasureNumberingValue
-> MeasureNumberingValue
-> MeasureNumberingValue
-> [MeasureNumberingValue]
enumFromTo :: MeasureNumberingValue
-> MeasureNumberingValue -> [MeasureNumberingValue]
$cenumFromTo :: MeasureNumberingValue
-> MeasureNumberingValue -> [MeasureNumberingValue]
enumFromThen :: MeasureNumberingValue
-> MeasureNumberingValue -> [MeasureNumberingValue]
$cenumFromThen :: MeasureNumberingValue
-> MeasureNumberingValue -> [MeasureNumberingValue]
enumFrom :: MeasureNumberingValue -> [MeasureNumberingValue]
$cenumFrom :: MeasureNumberingValue -> [MeasureNumberingValue]
fromEnum :: MeasureNumberingValue -> Int
$cfromEnum :: MeasureNumberingValue -> Int
toEnum :: Int -> MeasureNumberingValue
$ctoEnum :: Int -> MeasureNumberingValue
pred :: MeasureNumberingValue -> MeasureNumberingValue
$cpred :: MeasureNumberingValue -> MeasureNumberingValue
succ :: MeasureNumberingValue -> MeasureNumberingValue
$csucc :: MeasureNumberingValue -> MeasureNumberingValue
Enum,MeasureNumberingValue
MeasureNumberingValue
-> MeasureNumberingValue -> Bounded MeasureNumberingValue
forall a. a -> a -> Bounded a
maxBound :: MeasureNumberingValue
$cmaxBound :: MeasureNumberingValue
minBound :: MeasureNumberingValue
$cminBound :: MeasureNumberingValue
Bounded)
instance EmitXml MeasureNumberingValue where
    emitXml :: MeasureNumberingValue -> XmlRep
emitXml MeasureNumberingValue
MeasureNumberingValueNone = String -> XmlRep
XLit String
"none"
    emitXml MeasureNumberingValue
MeasureNumberingValueMeasure = String -> XmlRep
XLit String
"measure"
    emitXml MeasureNumberingValue
MeasureNumberingValueSystem = String -> XmlRep
XLit String
"system"
parseMeasureNumberingValue :: String -> P.XParse MeasureNumberingValue
parseMeasureNumberingValue :: String -> XParse MeasureNumberingValue
parseMeasureNumberingValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = MeasureNumberingValue -> XParse MeasureNumberingValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MeasureNumberingValue -> XParse MeasureNumberingValue)
-> MeasureNumberingValue -> XParse MeasureNumberingValue
forall a b. (a -> b) -> a -> b
$ MeasureNumberingValue
MeasureNumberingValueNone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"measure" = MeasureNumberingValue -> XParse MeasureNumberingValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MeasureNumberingValue -> XParse MeasureNumberingValue)
-> MeasureNumberingValue -> XParse MeasureNumberingValue
forall a b. (a -> b) -> a -> b
$ MeasureNumberingValue
MeasureNumberingValueMeasure
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"system" = MeasureNumberingValue -> XParse MeasureNumberingValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MeasureNumberingValue -> XParse MeasureNumberingValue)
-> MeasureNumberingValue -> XParse MeasureNumberingValue
forall a b. (a -> b) -> a -> b
$ MeasureNumberingValue
MeasureNumberingValueSystem
        | Bool
otherwise = String -> XParse MeasureNumberingValue
forall a. String -> XParse a
P.xfail (String -> XParse MeasureNumberingValue)
-> String -> XParse MeasureNumberingValue
forall a b. (a -> b) -> a -> b
$ String
"MeasureNumberingValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @measure-text@ /(simple)/
--
-- The measure-text type is used for the text attribute of measure elements. It has at least one character. The implicit attribute of the measure element should be set to "yes" rather than setting the text attribute to an empty string.
newtype MeasureText = MeasureText { MeasureText -> Token
measureText :: Token }
    deriving (MeasureText -> MeasureText -> Bool
(MeasureText -> MeasureText -> Bool)
-> (MeasureText -> MeasureText -> Bool) -> Eq MeasureText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureText -> MeasureText -> Bool
$c/= :: MeasureText -> MeasureText -> Bool
== :: MeasureText -> MeasureText -> Bool
$c== :: MeasureText -> MeasureText -> Bool
Eq,Typeable,(forall x. MeasureText -> Rep MeasureText x)
-> (forall x. Rep MeasureText x -> MeasureText)
-> Generic MeasureText
forall x. Rep MeasureText x -> MeasureText
forall x. MeasureText -> Rep MeasureText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureText x -> MeasureText
$cfrom :: forall x. MeasureText -> Rep MeasureText x
Generic,Eq MeasureText
Eq MeasureText
-> (MeasureText -> MeasureText -> Ordering)
-> (MeasureText -> MeasureText -> Bool)
-> (MeasureText -> MeasureText -> Bool)
-> (MeasureText -> MeasureText -> Bool)
-> (MeasureText -> MeasureText -> Bool)
-> (MeasureText -> MeasureText -> MeasureText)
-> (MeasureText -> MeasureText -> MeasureText)
-> Ord MeasureText
MeasureText -> MeasureText -> Bool
MeasureText -> MeasureText -> Ordering
MeasureText -> MeasureText -> MeasureText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MeasureText -> MeasureText -> MeasureText
$cmin :: MeasureText -> MeasureText -> MeasureText
max :: MeasureText -> MeasureText -> MeasureText
$cmax :: MeasureText -> MeasureText -> MeasureText
>= :: MeasureText -> MeasureText -> Bool
$c>= :: MeasureText -> MeasureText -> Bool
> :: MeasureText -> MeasureText -> Bool
$c> :: MeasureText -> MeasureText -> Bool
<= :: MeasureText -> MeasureText -> Bool
$c<= :: MeasureText -> MeasureText -> Bool
< :: MeasureText -> MeasureText -> Bool
$c< :: MeasureText -> MeasureText -> Bool
compare :: MeasureText -> MeasureText -> Ordering
$ccompare :: MeasureText -> MeasureText -> Ordering
$cp1Ord :: Eq MeasureText
Ord,String -> MeasureText
(String -> MeasureText) -> IsString MeasureText
forall a. (String -> a) -> IsString a
fromString :: String -> MeasureText
$cfromString :: String -> MeasureText
IsString)
instance Show MeasureText where show :: MeasureText -> String
show (MeasureText Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read MeasureText where readsPrec :: Int -> ReadS MeasureText
readsPrec Int
i = ((Token, String) -> (MeasureText, String))
-> [(Token, String)] -> [(MeasureText, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> MeasureText) -> (Token, String) -> (MeasureText, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> MeasureText
MeasureText) ([(Token, String)] -> [(MeasureText, String)])
-> (String -> [(Token, String)]) -> ReadS MeasureText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml MeasureText where
    emitXml :: MeasureText -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep)
-> (MeasureText -> Token) -> MeasureText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MeasureText -> Token
measureText
parseMeasureText :: String -> P.XParse MeasureText
parseMeasureText :: String -> XParse MeasureText
parseMeasureText = MeasureText -> XParse MeasureText
forall (m :: * -> *) a. Monad m => a -> m a
return (MeasureText -> XParse MeasureText)
-> (String -> MeasureText) -> String -> XParse MeasureText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MeasureText
forall a. IsString a => String -> a
fromString

-- | @membrane@ /(simple)/
--
-- The membrane type represents pictograms for membrane percussion instruments.
data Membrane = 
      MembraneBassDrum -- ^ /bass drum/
    | MembraneBassDrumOnSide -- ^ /bass drum on side/
    | MembraneBongos -- ^ /bongos/
    | MembraneChineseTomtom -- ^ /Chinese tomtom/
    | MembraneCongaDrum -- ^ /conga drum/
    | MembraneCuica -- ^ /cuica/
    | MembraneGobletDrum -- ^ /goblet drum/
    | MembraneIndoAmericanTomtom -- ^ /Indo-American tomtom/
    | MembraneJapaneseTomtom -- ^ /Japanese tomtom/
    | MembraneMilitaryDrum -- ^ /military drum/
    | MembraneSnareDrum -- ^ /snare drum/
    | MembraneSnareDrumSnaresOff -- ^ /snare drum snares off/
    | MembraneTabla -- ^ /tabla/
    | MembraneTambourine -- ^ /tambourine/
    | MembraneTenorDrum -- ^ /tenor drum/
    | MembraneTimbales -- ^ /timbales/
    | MembraneTomtom -- ^ /tomtom/
    deriving (Membrane -> Membrane -> Bool
(Membrane -> Membrane -> Bool)
-> (Membrane -> Membrane -> Bool) -> Eq Membrane
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Membrane -> Membrane -> Bool
$c/= :: Membrane -> Membrane -> Bool
== :: Membrane -> Membrane -> Bool
$c== :: Membrane -> Membrane -> Bool
Eq,Typeable,(forall x. Membrane -> Rep Membrane x)
-> (forall x. Rep Membrane x -> Membrane) -> Generic Membrane
forall x. Rep Membrane x -> Membrane
forall x. Membrane -> Rep Membrane x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Membrane x -> Membrane
$cfrom :: forall x. Membrane -> Rep Membrane x
Generic,Int -> Membrane -> ShowS
[Membrane] -> ShowS
Membrane -> String
(Int -> Membrane -> ShowS)
-> (Membrane -> String) -> ([Membrane] -> ShowS) -> Show Membrane
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Membrane] -> ShowS
$cshowList :: [Membrane] -> ShowS
show :: Membrane -> String
$cshow :: Membrane -> String
showsPrec :: Int -> Membrane -> ShowS
$cshowsPrec :: Int -> Membrane -> ShowS
Show,Eq Membrane
Eq Membrane
-> (Membrane -> Membrane -> Ordering)
-> (Membrane -> Membrane -> Bool)
-> (Membrane -> Membrane -> Bool)
-> (Membrane -> Membrane -> Bool)
-> (Membrane -> Membrane -> Bool)
-> (Membrane -> Membrane -> Membrane)
-> (Membrane -> Membrane -> Membrane)
-> Ord Membrane
Membrane -> Membrane -> Bool
Membrane -> Membrane -> Ordering
Membrane -> Membrane -> Membrane
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Membrane -> Membrane -> Membrane
$cmin :: Membrane -> Membrane -> Membrane
max :: Membrane -> Membrane -> Membrane
$cmax :: Membrane -> Membrane -> Membrane
>= :: Membrane -> Membrane -> Bool
$c>= :: Membrane -> Membrane -> Bool
> :: Membrane -> Membrane -> Bool
$c> :: Membrane -> Membrane -> Bool
<= :: Membrane -> Membrane -> Bool
$c<= :: Membrane -> Membrane -> Bool
< :: Membrane -> Membrane -> Bool
$c< :: Membrane -> Membrane -> Bool
compare :: Membrane -> Membrane -> Ordering
$ccompare :: Membrane -> Membrane -> Ordering
$cp1Ord :: Eq Membrane
Ord,Int -> Membrane
Membrane -> Int
Membrane -> [Membrane]
Membrane -> Membrane
Membrane -> Membrane -> [Membrane]
Membrane -> Membrane -> Membrane -> [Membrane]
(Membrane -> Membrane)
-> (Membrane -> Membrane)
-> (Int -> Membrane)
-> (Membrane -> Int)
-> (Membrane -> [Membrane])
-> (Membrane -> Membrane -> [Membrane])
-> (Membrane -> Membrane -> [Membrane])
-> (Membrane -> Membrane -> Membrane -> [Membrane])
-> Enum Membrane
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Membrane -> Membrane -> Membrane -> [Membrane]
$cenumFromThenTo :: Membrane -> Membrane -> Membrane -> [Membrane]
enumFromTo :: Membrane -> Membrane -> [Membrane]
$cenumFromTo :: Membrane -> Membrane -> [Membrane]
enumFromThen :: Membrane -> Membrane -> [Membrane]
$cenumFromThen :: Membrane -> Membrane -> [Membrane]
enumFrom :: Membrane -> [Membrane]
$cenumFrom :: Membrane -> [Membrane]
fromEnum :: Membrane -> Int
$cfromEnum :: Membrane -> Int
toEnum :: Int -> Membrane
$ctoEnum :: Int -> Membrane
pred :: Membrane -> Membrane
$cpred :: Membrane -> Membrane
succ :: Membrane -> Membrane
$csucc :: Membrane -> Membrane
Enum,Membrane
Membrane -> Membrane -> Bounded Membrane
forall a. a -> a -> Bounded a
maxBound :: Membrane
$cmaxBound :: Membrane
minBound :: Membrane
$cminBound :: Membrane
Bounded)
instance EmitXml Membrane where
    emitXml :: Membrane -> XmlRep
emitXml Membrane
MembraneBassDrum = String -> XmlRep
XLit String
"bass drum"
    emitXml Membrane
MembraneBassDrumOnSide = String -> XmlRep
XLit String
"bass drum on side"
    emitXml Membrane
MembraneBongos = String -> XmlRep
XLit String
"bongos"
    emitXml Membrane
MembraneChineseTomtom = String -> XmlRep
XLit String
"Chinese tomtom"
    emitXml Membrane
MembraneCongaDrum = String -> XmlRep
XLit String
"conga drum"
    emitXml Membrane
MembraneCuica = String -> XmlRep
XLit String
"cuica"
    emitXml Membrane
MembraneGobletDrum = String -> XmlRep
XLit String
"goblet drum"
    emitXml Membrane
MembraneIndoAmericanTomtom = String -> XmlRep
XLit String
"Indo-American tomtom"
    emitXml Membrane
MembraneJapaneseTomtom = String -> XmlRep
XLit String
"Japanese tomtom"
    emitXml Membrane
MembraneMilitaryDrum = String -> XmlRep
XLit String
"military drum"
    emitXml Membrane
MembraneSnareDrum = String -> XmlRep
XLit String
"snare drum"
    emitXml Membrane
MembraneSnareDrumSnaresOff = String -> XmlRep
XLit String
"snare drum snares off"
    emitXml Membrane
MembraneTabla = String -> XmlRep
XLit String
"tabla"
    emitXml Membrane
MembraneTambourine = String -> XmlRep
XLit String
"tambourine"
    emitXml Membrane
MembraneTenorDrum = String -> XmlRep
XLit String
"tenor drum"
    emitXml Membrane
MembraneTimbales = String -> XmlRep
XLit String
"timbales"
    emitXml Membrane
MembraneTomtom = String -> XmlRep
XLit String
"tomtom"
parseMembrane :: String -> P.XParse Membrane
parseMembrane :: String -> XParse Membrane
parseMembrane String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bass drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneBassDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bass drum on side" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneBassDrumOnSide
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bongos" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneBongos
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Chinese tomtom" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneChineseTomtom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"conga drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneCongaDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cuica" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneCuica
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"goblet drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneGobletDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Indo-American tomtom" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneIndoAmericanTomtom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Japanese tomtom" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneJapaneseTomtom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"military drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneMilitaryDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"snare drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneSnareDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"snare drum snares off" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneSnareDrumSnaresOff
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tabla" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneTabla
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tambourine" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneTambourine
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tenor drum" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneTenorDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"timbales" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneTimbales
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tomtom" = Membrane -> XParse Membrane
forall (m :: * -> *) a. Monad m => a -> m a
return (Membrane -> XParse Membrane) -> Membrane -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ Membrane
MembraneTomtom
        | Bool
otherwise = String -> XParse Membrane
forall a. String -> XParse a
P.xfail (String -> XParse Membrane) -> String -> XParse Membrane
forall a b. (a -> b) -> a -> b
$ String
"Membrane: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @metal@ /(simple)/
--
-- The metal type represents pictograms for metal percussion instruments. The hi-hat value refers to a pictogram like Stone's high-hat cymbals but without the long vertical line at the bottom.
data Metal = 
      MetalAgogo -- ^ /agogo/
    | MetalAlmglocken -- ^ /almglocken/
    | MetalBell -- ^ /bell/
    | MetalBellPlate -- ^ /bell plate/
    | MetalBellTree -- ^ /bell tree/
    | MetalBrakeDrum -- ^ /brake drum/
    | MetalCencerro -- ^ /cencerro/
    | MetalChainRattle -- ^ /chain rattle/
    | MetalChineseCymbal -- ^ /Chinese cymbal/
    | MetalCowbell -- ^ /cowbell/
    | MetalCrashCymbals -- ^ /crash cymbals/
    | MetalCrotale -- ^ /crotale/
    | MetalCymbalTongs -- ^ /cymbal tongs/
    | MetalDomedGong -- ^ /domed gong/
    | MetalFingerCymbals -- ^ /finger cymbals/
    | MetalFlexatone -- ^ /flexatone/
    | MetalGong -- ^ /gong/
    | MetalHiHat -- ^ /hi-hat/
    | MetalHighHatCymbals -- ^ /high-hat cymbals/
    | MetalHandbell -- ^ /handbell/
    | MetalJawHarp -- ^ /jaw harp/
    | MetalJingleBells -- ^ /jingle bells/
    | MetalMusicalSaw -- ^ /musical saw/
    | MetalShellBells -- ^ /shell bells/
    | MetalSistrum -- ^ /sistrum/
    | MetalSizzleCymbal -- ^ /sizzle cymbal/
    | MetalSleighBells -- ^ /sleigh bells/
    | MetalSuspendedCymbal -- ^ /suspended cymbal/
    | MetalTamTam -- ^ /tam tam/
    | MetalTamTamWithBeater -- ^ /tam tam with beater/
    | MetalTriangle -- ^ /triangle/
    | MetalVietnameseHat -- ^ /Vietnamese hat/
    deriving (Metal -> Metal -> Bool
(Metal -> Metal -> Bool) -> (Metal -> Metal -> Bool) -> Eq Metal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metal -> Metal -> Bool
$c/= :: Metal -> Metal -> Bool
== :: Metal -> Metal -> Bool
$c== :: Metal -> Metal -> Bool
Eq,Typeable,(forall x. Metal -> Rep Metal x)
-> (forall x. Rep Metal x -> Metal) -> Generic Metal
forall x. Rep Metal x -> Metal
forall x. Metal -> Rep Metal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metal x -> Metal
$cfrom :: forall x. Metal -> Rep Metal x
Generic,Int -> Metal -> ShowS
[Metal] -> ShowS
Metal -> String
(Int -> Metal -> ShowS)
-> (Metal -> String) -> ([Metal] -> ShowS) -> Show Metal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metal] -> ShowS
$cshowList :: [Metal] -> ShowS
show :: Metal -> String
$cshow :: Metal -> String
showsPrec :: Int -> Metal -> ShowS
$cshowsPrec :: Int -> Metal -> ShowS
Show,Eq Metal
Eq Metal
-> (Metal -> Metal -> Ordering)
-> (Metal -> Metal -> Bool)
-> (Metal -> Metal -> Bool)
-> (Metal -> Metal -> Bool)
-> (Metal -> Metal -> Bool)
-> (Metal -> Metal -> Metal)
-> (Metal -> Metal -> Metal)
-> Ord Metal
Metal -> Metal -> Bool
Metal -> Metal -> Ordering
Metal -> Metal -> Metal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Metal -> Metal -> Metal
$cmin :: Metal -> Metal -> Metal
max :: Metal -> Metal -> Metal
$cmax :: Metal -> Metal -> Metal
>= :: Metal -> Metal -> Bool
$c>= :: Metal -> Metal -> Bool
> :: Metal -> Metal -> Bool
$c> :: Metal -> Metal -> Bool
<= :: Metal -> Metal -> Bool
$c<= :: Metal -> Metal -> Bool
< :: Metal -> Metal -> Bool
$c< :: Metal -> Metal -> Bool
compare :: Metal -> Metal -> Ordering
$ccompare :: Metal -> Metal -> Ordering
$cp1Ord :: Eq Metal
Ord,Int -> Metal
Metal -> Int
Metal -> [Metal]
Metal -> Metal
Metal -> Metal -> [Metal]
Metal -> Metal -> Metal -> [Metal]
(Metal -> Metal)
-> (Metal -> Metal)
-> (Int -> Metal)
-> (Metal -> Int)
-> (Metal -> [Metal])
-> (Metal -> Metal -> [Metal])
-> (Metal -> Metal -> [Metal])
-> (Metal -> Metal -> Metal -> [Metal])
-> Enum Metal
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Metal -> Metal -> Metal -> [Metal]
$cenumFromThenTo :: Metal -> Metal -> Metal -> [Metal]
enumFromTo :: Metal -> Metal -> [Metal]
$cenumFromTo :: Metal -> Metal -> [Metal]
enumFromThen :: Metal -> Metal -> [Metal]
$cenumFromThen :: Metal -> Metal -> [Metal]
enumFrom :: Metal -> [Metal]
$cenumFrom :: Metal -> [Metal]
fromEnum :: Metal -> Int
$cfromEnum :: Metal -> Int
toEnum :: Int -> Metal
$ctoEnum :: Int -> Metal
pred :: Metal -> Metal
$cpred :: Metal -> Metal
succ :: Metal -> Metal
$csucc :: Metal -> Metal
Enum,Metal
Metal -> Metal -> Bounded Metal
forall a. a -> a -> Bounded a
maxBound :: Metal
$cmaxBound :: Metal
minBound :: Metal
$cminBound :: Metal
Bounded)
instance EmitXml Metal where
    emitXml :: Metal -> XmlRep
emitXml Metal
MetalAgogo = String -> XmlRep
XLit String
"agogo"
    emitXml Metal
MetalAlmglocken = String -> XmlRep
XLit String
"almglocken"
    emitXml Metal
MetalBell = String -> XmlRep
XLit String
"bell"
    emitXml Metal
MetalBellPlate = String -> XmlRep
XLit String
"bell plate"
    emitXml Metal
MetalBellTree = String -> XmlRep
XLit String
"bell tree"
    emitXml Metal
MetalBrakeDrum = String -> XmlRep
XLit String
"brake drum"
    emitXml Metal
MetalCencerro = String -> XmlRep
XLit String
"cencerro"
    emitXml Metal
MetalChainRattle = String -> XmlRep
XLit String
"chain rattle"
    emitXml Metal
MetalChineseCymbal = String -> XmlRep
XLit String
"Chinese cymbal"
    emitXml Metal
MetalCowbell = String -> XmlRep
XLit String
"cowbell"
    emitXml Metal
MetalCrashCymbals = String -> XmlRep
XLit String
"crash cymbals"
    emitXml Metal
MetalCrotale = String -> XmlRep
XLit String
"crotale"
    emitXml Metal
MetalCymbalTongs = String -> XmlRep
XLit String
"cymbal tongs"
    emitXml Metal
MetalDomedGong = String -> XmlRep
XLit String
"domed gong"
    emitXml Metal
MetalFingerCymbals = String -> XmlRep
XLit String
"finger cymbals"
    emitXml Metal
MetalFlexatone = String -> XmlRep
XLit String
"flexatone"
    emitXml Metal
MetalGong = String -> XmlRep
XLit String
"gong"
    emitXml Metal
MetalHiHat = String -> XmlRep
XLit String
"hi-hat"
    emitXml Metal
MetalHighHatCymbals = String -> XmlRep
XLit String
"high-hat cymbals"
    emitXml Metal
MetalHandbell = String -> XmlRep
XLit String
"handbell"
    emitXml Metal
MetalJawHarp = String -> XmlRep
XLit String
"jaw harp"
    emitXml Metal
MetalJingleBells = String -> XmlRep
XLit String
"jingle bells"
    emitXml Metal
MetalMusicalSaw = String -> XmlRep
XLit String
"musical saw"
    emitXml Metal
MetalShellBells = String -> XmlRep
XLit String
"shell bells"
    emitXml Metal
MetalSistrum = String -> XmlRep
XLit String
"sistrum"
    emitXml Metal
MetalSizzleCymbal = String -> XmlRep
XLit String
"sizzle cymbal"
    emitXml Metal
MetalSleighBells = String -> XmlRep
XLit String
"sleigh bells"
    emitXml Metal
MetalSuspendedCymbal = String -> XmlRep
XLit String
"suspended cymbal"
    emitXml Metal
MetalTamTam = String -> XmlRep
XLit String
"tam tam"
    emitXml Metal
MetalTamTamWithBeater = String -> XmlRep
XLit String
"tam tam with beater"
    emitXml Metal
MetalTriangle = String -> XmlRep
XLit String
"triangle"
    emitXml Metal
MetalVietnameseHat = String -> XmlRep
XLit String
"Vietnamese hat"
parseMetal :: String -> P.XParse Metal
parseMetal :: String -> XParse Metal
parseMetal String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"agogo" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalAgogo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"almglocken" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalAlmglocken
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bell" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalBell
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bell plate" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalBellPlate
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bell tree" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalBellTree
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"brake drum" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalBrakeDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cencerro" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalCencerro
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"chain rattle" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalChainRattle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Chinese cymbal" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalChineseCymbal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cowbell" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalCowbell
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"crash cymbals" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalCrashCymbals
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"crotale" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalCrotale
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cymbal tongs" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalCymbalTongs
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"domed gong" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalDomedGong
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"finger cymbals" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalFingerCymbals
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"flexatone" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalFlexatone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"gong" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalGong
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hi-hat" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalHiHat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"high-hat cymbals" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalHighHatCymbals
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"handbell" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalHandbell
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"jaw harp" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalJawHarp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"jingle bells" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalJingleBells
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"musical saw" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalMusicalSaw
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"shell bells" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalShellBells
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sistrum" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalSistrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sizzle cymbal" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalSizzleCymbal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sleigh bells" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalSleighBells
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"suspended cymbal" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalSuspendedCymbal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tam tam" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalTamTam
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tam tam with beater" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalTamTamWithBeater
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triangle" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalTriangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Vietnamese hat" = Metal -> XParse Metal
forall (m :: * -> *) a. Monad m => a -> m a
return (Metal -> XParse Metal) -> Metal -> XParse Metal
forall a b. (a -> b) -> a -> b
$ Metal
MetalVietnameseHat
        | Bool
otherwise = String -> XParse Metal
forall a. String -> XParse a
P.xfail (String -> XParse Metal) -> String -> XParse Metal
forall a b. (a -> b) -> a -> b
$ String
"Metal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @midi-128@ /(simple)/
--
-- The midi-16 type is used to express MIDI 1.0 values that range from 1 to 128.
newtype Midi128 = Midi128 { Midi128 -> PositiveInteger
midi128 :: PositiveInteger }
    deriving (Midi128 -> Midi128 -> Bool
(Midi128 -> Midi128 -> Bool)
-> (Midi128 -> Midi128 -> Bool) -> Eq Midi128
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Midi128 -> Midi128 -> Bool
$c/= :: Midi128 -> Midi128 -> Bool
== :: Midi128 -> Midi128 -> Bool
$c== :: Midi128 -> Midi128 -> Bool
Eq,Typeable,(forall x. Midi128 -> Rep Midi128 x)
-> (forall x. Rep Midi128 x -> Midi128) -> Generic Midi128
forall x. Rep Midi128 x -> Midi128
forall x. Midi128 -> Rep Midi128 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Midi128 x -> Midi128
$cfrom :: forall x. Midi128 -> Rep Midi128 x
Generic,Eq Midi128
Eq Midi128
-> (Midi128 -> Midi128 -> Ordering)
-> (Midi128 -> Midi128 -> Bool)
-> (Midi128 -> Midi128 -> Bool)
-> (Midi128 -> Midi128 -> Bool)
-> (Midi128 -> Midi128 -> Bool)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> Ord Midi128
Midi128 -> Midi128 -> Bool
Midi128 -> Midi128 -> Ordering
Midi128 -> Midi128 -> Midi128
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Midi128 -> Midi128 -> Midi128
$cmin :: Midi128 -> Midi128 -> Midi128
max :: Midi128 -> Midi128 -> Midi128
$cmax :: Midi128 -> Midi128 -> Midi128
>= :: Midi128 -> Midi128 -> Bool
$c>= :: Midi128 -> Midi128 -> Bool
> :: Midi128 -> Midi128 -> Bool
$c> :: Midi128 -> Midi128 -> Bool
<= :: Midi128 -> Midi128 -> Bool
$c<= :: Midi128 -> Midi128 -> Bool
< :: Midi128 -> Midi128 -> Bool
$c< :: Midi128 -> Midi128 -> Bool
compare :: Midi128 -> Midi128 -> Ordering
$ccompare :: Midi128 -> Midi128 -> Ordering
$cp1Ord :: Eq Midi128
Ord,Midi128
Midi128 -> Midi128 -> Bounded Midi128
forall a. a -> a -> Bounded a
maxBound :: Midi128
$cmaxBound :: Midi128
minBound :: Midi128
$cminBound :: Midi128
Bounded,Int -> Midi128
Midi128 -> Int
Midi128 -> [Midi128]
Midi128 -> Midi128
Midi128 -> Midi128 -> [Midi128]
Midi128 -> Midi128 -> Midi128 -> [Midi128]
(Midi128 -> Midi128)
-> (Midi128 -> Midi128)
-> (Int -> Midi128)
-> (Midi128 -> Int)
-> (Midi128 -> [Midi128])
-> (Midi128 -> Midi128 -> [Midi128])
-> (Midi128 -> Midi128 -> [Midi128])
-> (Midi128 -> Midi128 -> Midi128 -> [Midi128])
-> Enum Midi128
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Midi128 -> Midi128 -> Midi128 -> [Midi128]
$cenumFromThenTo :: Midi128 -> Midi128 -> Midi128 -> [Midi128]
enumFromTo :: Midi128 -> Midi128 -> [Midi128]
$cenumFromTo :: Midi128 -> Midi128 -> [Midi128]
enumFromThen :: Midi128 -> Midi128 -> [Midi128]
$cenumFromThen :: Midi128 -> Midi128 -> [Midi128]
enumFrom :: Midi128 -> [Midi128]
$cenumFrom :: Midi128 -> [Midi128]
fromEnum :: Midi128 -> Int
$cfromEnum :: Midi128 -> Int
toEnum :: Int -> Midi128
$ctoEnum :: Int -> Midi128
pred :: Midi128 -> Midi128
$cpred :: Midi128 -> Midi128
succ :: Midi128 -> Midi128
$csucc :: Midi128 -> Midi128
Enum,Integer -> Midi128
Midi128 -> Midi128
Midi128 -> Midi128 -> Midi128
(Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128)
-> (Midi128 -> Midi128)
-> (Midi128 -> Midi128)
-> (Integer -> Midi128)
-> Num Midi128
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Midi128
$cfromInteger :: Integer -> Midi128
signum :: Midi128 -> Midi128
$csignum :: Midi128 -> Midi128
abs :: Midi128 -> Midi128
$cabs :: Midi128 -> Midi128
negate :: Midi128 -> Midi128
$cnegate :: Midi128 -> Midi128
* :: Midi128 -> Midi128 -> Midi128
$c* :: Midi128 -> Midi128 -> Midi128
- :: Midi128 -> Midi128 -> Midi128
$c- :: Midi128 -> Midi128 -> Midi128
+ :: Midi128 -> Midi128 -> Midi128
$c+ :: Midi128 -> Midi128 -> Midi128
Num,Num Midi128
Ord Midi128
Num Midi128 -> Ord Midi128 -> (Midi128 -> Rational) -> Real Midi128
Midi128 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Midi128 -> Rational
$ctoRational :: Midi128 -> Rational
$cp2Real :: Ord Midi128
$cp1Real :: Num Midi128
Real,Enum Midi128
Real Midi128
Real Midi128
-> Enum Midi128
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> Midi128)
-> (Midi128 -> Midi128 -> (Midi128, Midi128))
-> (Midi128 -> Midi128 -> (Midi128, Midi128))
-> (Midi128 -> Integer)
-> Integral Midi128
Midi128 -> Integer
Midi128 -> Midi128 -> (Midi128, Midi128)
Midi128 -> Midi128 -> Midi128
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Midi128 -> Integer
$ctoInteger :: Midi128 -> Integer
divMod :: Midi128 -> Midi128 -> (Midi128, Midi128)
$cdivMod :: Midi128 -> Midi128 -> (Midi128, Midi128)
quotRem :: Midi128 -> Midi128 -> (Midi128, Midi128)
$cquotRem :: Midi128 -> Midi128 -> (Midi128, Midi128)
mod :: Midi128 -> Midi128 -> Midi128
$cmod :: Midi128 -> Midi128 -> Midi128
div :: Midi128 -> Midi128 -> Midi128
$cdiv :: Midi128 -> Midi128 -> Midi128
rem :: Midi128 -> Midi128 -> Midi128
$crem :: Midi128 -> Midi128 -> Midi128
quot :: Midi128 -> Midi128 -> Midi128
$cquot :: Midi128 -> Midi128 -> Midi128
$cp2Integral :: Enum Midi128
$cp1Integral :: Real Midi128
Integral)
instance Show Midi128 where show :: Midi128 -> String
show (Midi128 PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read Midi128 where readsPrec :: Int -> ReadS Midi128
readsPrec Int
i = ((PositiveInteger, String) -> (Midi128, String))
-> [(PositiveInteger, String)] -> [(Midi128, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> Midi128)
-> (PositiveInteger, String) -> (Midi128, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> Midi128
Midi128) ([(PositiveInteger, String)] -> [(Midi128, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS Midi128
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Midi128 where
    emitXml :: Midi128 -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (Midi128 -> PositiveInteger) -> Midi128 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi128 -> PositiveInteger
midi128
parseMidi128 :: String -> P.XParse Midi128
parseMidi128 :: String -> XParse Midi128
parseMidi128 = String -> String -> XParse Midi128
forall a. Read a => String -> String -> XParse a
P.xread String
"Midi128"

-- | @midi-16@ /(simple)/
--
-- The midi-16 type is used to express MIDI 1.0 values that range from 1 to 16.
newtype Midi16 = Midi16 { Midi16 -> PositiveInteger
midi16 :: PositiveInteger }
    deriving (Midi16 -> Midi16 -> Bool
(Midi16 -> Midi16 -> Bool)
-> (Midi16 -> Midi16 -> Bool) -> Eq Midi16
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Midi16 -> Midi16 -> Bool
$c/= :: Midi16 -> Midi16 -> Bool
== :: Midi16 -> Midi16 -> Bool
$c== :: Midi16 -> Midi16 -> Bool
Eq,Typeable,(forall x. Midi16 -> Rep Midi16 x)
-> (forall x. Rep Midi16 x -> Midi16) -> Generic Midi16
forall x. Rep Midi16 x -> Midi16
forall x. Midi16 -> Rep Midi16 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Midi16 x -> Midi16
$cfrom :: forall x. Midi16 -> Rep Midi16 x
Generic,Eq Midi16
Eq Midi16
-> (Midi16 -> Midi16 -> Ordering)
-> (Midi16 -> Midi16 -> Bool)
-> (Midi16 -> Midi16 -> Bool)
-> (Midi16 -> Midi16 -> Bool)
-> (Midi16 -> Midi16 -> Bool)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> Ord Midi16
Midi16 -> Midi16 -> Bool
Midi16 -> Midi16 -> Ordering
Midi16 -> Midi16 -> Midi16
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Midi16 -> Midi16 -> Midi16
$cmin :: Midi16 -> Midi16 -> Midi16
max :: Midi16 -> Midi16 -> Midi16
$cmax :: Midi16 -> Midi16 -> Midi16
>= :: Midi16 -> Midi16 -> Bool
$c>= :: Midi16 -> Midi16 -> Bool
> :: Midi16 -> Midi16 -> Bool
$c> :: Midi16 -> Midi16 -> Bool
<= :: Midi16 -> Midi16 -> Bool
$c<= :: Midi16 -> Midi16 -> Bool
< :: Midi16 -> Midi16 -> Bool
$c< :: Midi16 -> Midi16 -> Bool
compare :: Midi16 -> Midi16 -> Ordering
$ccompare :: Midi16 -> Midi16 -> Ordering
$cp1Ord :: Eq Midi16
Ord,Midi16
Midi16 -> Midi16 -> Bounded Midi16
forall a. a -> a -> Bounded a
maxBound :: Midi16
$cmaxBound :: Midi16
minBound :: Midi16
$cminBound :: Midi16
Bounded,Int -> Midi16
Midi16 -> Int
Midi16 -> [Midi16]
Midi16 -> Midi16
Midi16 -> Midi16 -> [Midi16]
Midi16 -> Midi16 -> Midi16 -> [Midi16]
(Midi16 -> Midi16)
-> (Midi16 -> Midi16)
-> (Int -> Midi16)
-> (Midi16 -> Int)
-> (Midi16 -> [Midi16])
-> (Midi16 -> Midi16 -> [Midi16])
-> (Midi16 -> Midi16 -> [Midi16])
-> (Midi16 -> Midi16 -> Midi16 -> [Midi16])
-> Enum Midi16
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Midi16 -> Midi16 -> Midi16 -> [Midi16]
$cenumFromThenTo :: Midi16 -> Midi16 -> Midi16 -> [Midi16]
enumFromTo :: Midi16 -> Midi16 -> [Midi16]
$cenumFromTo :: Midi16 -> Midi16 -> [Midi16]
enumFromThen :: Midi16 -> Midi16 -> [Midi16]
$cenumFromThen :: Midi16 -> Midi16 -> [Midi16]
enumFrom :: Midi16 -> [Midi16]
$cenumFrom :: Midi16 -> [Midi16]
fromEnum :: Midi16 -> Int
$cfromEnum :: Midi16 -> Int
toEnum :: Int -> Midi16
$ctoEnum :: Int -> Midi16
pred :: Midi16 -> Midi16
$cpred :: Midi16 -> Midi16
succ :: Midi16 -> Midi16
$csucc :: Midi16 -> Midi16
Enum,Integer -> Midi16
Midi16 -> Midi16
Midi16 -> Midi16 -> Midi16
(Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16)
-> (Midi16 -> Midi16)
-> (Midi16 -> Midi16)
-> (Integer -> Midi16)
-> Num Midi16
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Midi16
$cfromInteger :: Integer -> Midi16
signum :: Midi16 -> Midi16
$csignum :: Midi16 -> Midi16
abs :: Midi16 -> Midi16
$cabs :: Midi16 -> Midi16
negate :: Midi16 -> Midi16
$cnegate :: Midi16 -> Midi16
* :: Midi16 -> Midi16 -> Midi16
$c* :: Midi16 -> Midi16 -> Midi16
- :: Midi16 -> Midi16 -> Midi16
$c- :: Midi16 -> Midi16 -> Midi16
+ :: Midi16 -> Midi16 -> Midi16
$c+ :: Midi16 -> Midi16 -> Midi16
Num,Num Midi16
Ord Midi16
Num Midi16 -> Ord Midi16 -> (Midi16 -> Rational) -> Real Midi16
Midi16 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Midi16 -> Rational
$ctoRational :: Midi16 -> Rational
$cp2Real :: Ord Midi16
$cp1Real :: Num Midi16
Real,Enum Midi16
Real Midi16
Real Midi16
-> Enum Midi16
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> Midi16)
-> (Midi16 -> Midi16 -> (Midi16, Midi16))
-> (Midi16 -> Midi16 -> (Midi16, Midi16))
-> (Midi16 -> Integer)
-> Integral Midi16
Midi16 -> Integer
Midi16 -> Midi16 -> (Midi16, Midi16)
Midi16 -> Midi16 -> Midi16
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Midi16 -> Integer
$ctoInteger :: Midi16 -> Integer
divMod :: Midi16 -> Midi16 -> (Midi16, Midi16)
$cdivMod :: Midi16 -> Midi16 -> (Midi16, Midi16)
quotRem :: Midi16 -> Midi16 -> (Midi16, Midi16)
$cquotRem :: Midi16 -> Midi16 -> (Midi16, Midi16)
mod :: Midi16 -> Midi16 -> Midi16
$cmod :: Midi16 -> Midi16 -> Midi16
div :: Midi16 -> Midi16 -> Midi16
$cdiv :: Midi16 -> Midi16 -> Midi16
rem :: Midi16 -> Midi16 -> Midi16
$crem :: Midi16 -> Midi16 -> Midi16
quot :: Midi16 -> Midi16 -> Midi16
$cquot :: Midi16 -> Midi16 -> Midi16
$cp2Integral :: Enum Midi16
$cp1Integral :: Real Midi16
Integral)
instance Show Midi16 where show :: Midi16 -> String
show (Midi16 PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read Midi16 where readsPrec :: Int -> ReadS Midi16
readsPrec Int
i = ((PositiveInteger, String) -> (Midi16, String))
-> [(PositiveInteger, String)] -> [(Midi16, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> Midi16)
-> (PositiveInteger, String) -> (Midi16, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> Midi16
Midi16) ([(PositiveInteger, String)] -> [(Midi16, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS Midi16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Midi16 where
    emitXml :: Midi16 -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (Midi16 -> PositiveInteger) -> Midi16 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi16 -> PositiveInteger
midi16
parseMidi16 :: String -> P.XParse Midi16
parseMidi16 :: String -> XParse Midi16
parseMidi16 = String -> String -> XParse Midi16
forall a. Read a => String -> String -> XParse a
P.xread String
"Midi16"

-- | @midi-16384@ /(simple)/
--
-- The midi-16 type is used to express MIDI 1.0 values that range from 1 to 16,384.
newtype Midi16384 = Midi16384 { Midi16384 -> PositiveInteger
midi16384 :: PositiveInteger }
    deriving (Midi16384 -> Midi16384 -> Bool
(Midi16384 -> Midi16384 -> Bool)
-> (Midi16384 -> Midi16384 -> Bool) -> Eq Midi16384
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Midi16384 -> Midi16384 -> Bool
$c/= :: Midi16384 -> Midi16384 -> Bool
== :: Midi16384 -> Midi16384 -> Bool
$c== :: Midi16384 -> Midi16384 -> Bool
Eq,Typeable,(forall x. Midi16384 -> Rep Midi16384 x)
-> (forall x. Rep Midi16384 x -> Midi16384) -> Generic Midi16384
forall x. Rep Midi16384 x -> Midi16384
forall x. Midi16384 -> Rep Midi16384 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Midi16384 x -> Midi16384
$cfrom :: forall x. Midi16384 -> Rep Midi16384 x
Generic,Eq Midi16384
Eq Midi16384
-> (Midi16384 -> Midi16384 -> Ordering)
-> (Midi16384 -> Midi16384 -> Bool)
-> (Midi16384 -> Midi16384 -> Bool)
-> (Midi16384 -> Midi16384 -> Bool)
-> (Midi16384 -> Midi16384 -> Bool)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> Ord Midi16384
Midi16384 -> Midi16384 -> Bool
Midi16384 -> Midi16384 -> Ordering
Midi16384 -> Midi16384 -> Midi16384
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Midi16384 -> Midi16384 -> Midi16384
$cmin :: Midi16384 -> Midi16384 -> Midi16384
max :: Midi16384 -> Midi16384 -> Midi16384
$cmax :: Midi16384 -> Midi16384 -> Midi16384
>= :: Midi16384 -> Midi16384 -> Bool
$c>= :: Midi16384 -> Midi16384 -> Bool
> :: Midi16384 -> Midi16384 -> Bool
$c> :: Midi16384 -> Midi16384 -> Bool
<= :: Midi16384 -> Midi16384 -> Bool
$c<= :: Midi16384 -> Midi16384 -> Bool
< :: Midi16384 -> Midi16384 -> Bool
$c< :: Midi16384 -> Midi16384 -> Bool
compare :: Midi16384 -> Midi16384 -> Ordering
$ccompare :: Midi16384 -> Midi16384 -> Ordering
$cp1Ord :: Eq Midi16384
Ord,Midi16384
Midi16384 -> Midi16384 -> Bounded Midi16384
forall a. a -> a -> Bounded a
maxBound :: Midi16384
$cmaxBound :: Midi16384
minBound :: Midi16384
$cminBound :: Midi16384
Bounded,Int -> Midi16384
Midi16384 -> Int
Midi16384 -> [Midi16384]
Midi16384 -> Midi16384
Midi16384 -> Midi16384 -> [Midi16384]
Midi16384 -> Midi16384 -> Midi16384 -> [Midi16384]
(Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384)
-> (Int -> Midi16384)
-> (Midi16384 -> Int)
-> (Midi16384 -> [Midi16384])
-> (Midi16384 -> Midi16384 -> [Midi16384])
-> (Midi16384 -> Midi16384 -> [Midi16384])
-> (Midi16384 -> Midi16384 -> Midi16384 -> [Midi16384])
-> Enum Midi16384
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Midi16384 -> Midi16384 -> Midi16384 -> [Midi16384]
$cenumFromThenTo :: Midi16384 -> Midi16384 -> Midi16384 -> [Midi16384]
enumFromTo :: Midi16384 -> Midi16384 -> [Midi16384]
$cenumFromTo :: Midi16384 -> Midi16384 -> [Midi16384]
enumFromThen :: Midi16384 -> Midi16384 -> [Midi16384]
$cenumFromThen :: Midi16384 -> Midi16384 -> [Midi16384]
enumFrom :: Midi16384 -> [Midi16384]
$cenumFrom :: Midi16384 -> [Midi16384]
fromEnum :: Midi16384 -> Int
$cfromEnum :: Midi16384 -> Int
toEnum :: Int -> Midi16384
$ctoEnum :: Int -> Midi16384
pred :: Midi16384 -> Midi16384
$cpred :: Midi16384 -> Midi16384
succ :: Midi16384 -> Midi16384
$csucc :: Midi16384 -> Midi16384
Enum,Integer -> Midi16384
Midi16384 -> Midi16384
Midi16384 -> Midi16384 -> Midi16384
(Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384)
-> (Integer -> Midi16384)
-> Num Midi16384
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Midi16384
$cfromInteger :: Integer -> Midi16384
signum :: Midi16384 -> Midi16384
$csignum :: Midi16384 -> Midi16384
abs :: Midi16384 -> Midi16384
$cabs :: Midi16384 -> Midi16384
negate :: Midi16384 -> Midi16384
$cnegate :: Midi16384 -> Midi16384
* :: Midi16384 -> Midi16384 -> Midi16384
$c* :: Midi16384 -> Midi16384 -> Midi16384
- :: Midi16384 -> Midi16384 -> Midi16384
$c- :: Midi16384 -> Midi16384 -> Midi16384
+ :: Midi16384 -> Midi16384 -> Midi16384
$c+ :: Midi16384 -> Midi16384 -> Midi16384
Num,Num Midi16384
Ord Midi16384
Num Midi16384
-> Ord Midi16384 -> (Midi16384 -> Rational) -> Real Midi16384
Midi16384 -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Midi16384 -> Rational
$ctoRational :: Midi16384 -> Rational
$cp2Real :: Ord Midi16384
$cp1Real :: Num Midi16384
Real,Enum Midi16384
Real Midi16384
Real Midi16384
-> Enum Midi16384
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> Midi16384)
-> (Midi16384 -> Midi16384 -> (Midi16384, Midi16384))
-> (Midi16384 -> Midi16384 -> (Midi16384, Midi16384))
-> (Midi16384 -> Integer)
-> Integral Midi16384
Midi16384 -> Integer
Midi16384 -> Midi16384 -> (Midi16384, Midi16384)
Midi16384 -> Midi16384 -> Midi16384
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Midi16384 -> Integer
$ctoInteger :: Midi16384 -> Integer
divMod :: Midi16384 -> Midi16384 -> (Midi16384, Midi16384)
$cdivMod :: Midi16384 -> Midi16384 -> (Midi16384, Midi16384)
quotRem :: Midi16384 -> Midi16384 -> (Midi16384, Midi16384)
$cquotRem :: Midi16384 -> Midi16384 -> (Midi16384, Midi16384)
mod :: Midi16384 -> Midi16384 -> Midi16384
$cmod :: Midi16384 -> Midi16384 -> Midi16384
div :: Midi16384 -> Midi16384 -> Midi16384
$cdiv :: Midi16384 -> Midi16384 -> Midi16384
rem :: Midi16384 -> Midi16384 -> Midi16384
$crem :: Midi16384 -> Midi16384 -> Midi16384
quot :: Midi16384 -> Midi16384 -> Midi16384
$cquot :: Midi16384 -> Midi16384 -> Midi16384
$cp2Integral :: Enum Midi16384
$cp1Integral :: Real Midi16384
Integral)
instance Show Midi16384 where show :: Midi16384 -> String
show (Midi16384 PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read Midi16384 where readsPrec :: Int -> ReadS Midi16384
readsPrec Int
i = ((PositiveInteger, String) -> (Midi16384, String))
-> [(PositiveInteger, String)] -> [(Midi16384, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> Midi16384)
-> (PositiveInteger, String) -> (Midi16384, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> Midi16384
Midi16384) ([(PositiveInteger, String)] -> [(Midi16384, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS Midi16384
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Midi16384 where
    emitXml :: Midi16384 -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (Midi16384 -> PositiveInteger) -> Midi16384 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi16384 -> PositiveInteger
midi16384
parseMidi16384 :: String -> P.XParse Midi16384
parseMidi16384 :: String -> XParse Midi16384
parseMidi16384 = String -> String -> XParse Midi16384
forall a. Read a => String -> String -> XParse a
P.xread String
"Midi16384"

-- | @millimeters@ /(simple)/
--
-- The millimeters type is a number representing millimeters. This is used in the scaling element to provide a default scaling from tenths to physical units.
newtype Millimeters = Millimeters { Millimeters -> Decimal
millimeters :: Decimal }
    deriving (Millimeters -> Millimeters -> Bool
(Millimeters -> Millimeters -> Bool)
-> (Millimeters -> Millimeters -> Bool) -> Eq Millimeters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Millimeters -> Millimeters -> Bool
$c/= :: Millimeters -> Millimeters -> Bool
== :: Millimeters -> Millimeters -> Bool
$c== :: Millimeters -> Millimeters -> Bool
Eq,Typeable,(forall x. Millimeters -> Rep Millimeters x)
-> (forall x. Rep Millimeters x -> Millimeters)
-> Generic Millimeters
forall x. Rep Millimeters x -> Millimeters
forall x. Millimeters -> Rep Millimeters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Millimeters x -> Millimeters
$cfrom :: forall x. Millimeters -> Rep Millimeters x
Generic,Eq Millimeters
Eq Millimeters
-> (Millimeters -> Millimeters -> Ordering)
-> (Millimeters -> Millimeters -> Bool)
-> (Millimeters -> Millimeters -> Bool)
-> (Millimeters -> Millimeters -> Bool)
-> (Millimeters -> Millimeters -> Bool)
-> (Millimeters -> Millimeters -> Millimeters)
-> (Millimeters -> Millimeters -> Millimeters)
-> Ord Millimeters
Millimeters -> Millimeters -> Bool
Millimeters -> Millimeters -> Ordering
Millimeters -> Millimeters -> Millimeters
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Millimeters -> Millimeters -> Millimeters
$cmin :: Millimeters -> Millimeters -> Millimeters
max :: Millimeters -> Millimeters -> Millimeters
$cmax :: Millimeters -> Millimeters -> Millimeters
>= :: Millimeters -> Millimeters -> Bool
$c>= :: Millimeters -> Millimeters -> Bool
> :: Millimeters -> Millimeters -> Bool
$c> :: Millimeters -> Millimeters -> Bool
<= :: Millimeters -> Millimeters -> Bool
$c<= :: Millimeters -> Millimeters -> Bool
< :: Millimeters -> Millimeters -> Bool
$c< :: Millimeters -> Millimeters -> Bool
compare :: Millimeters -> Millimeters -> Ordering
$ccompare :: Millimeters -> Millimeters -> Ordering
$cp1Ord :: Eq Millimeters
Ord,Integer -> Millimeters
Millimeters -> Millimeters
Millimeters -> Millimeters -> Millimeters
(Millimeters -> Millimeters -> Millimeters)
-> (Millimeters -> Millimeters -> Millimeters)
-> (Millimeters -> Millimeters -> Millimeters)
-> (Millimeters -> Millimeters)
-> (Millimeters -> Millimeters)
-> (Millimeters -> Millimeters)
-> (Integer -> Millimeters)
-> Num Millimeters
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Millimeters
$cfromInteger :: Integer -> Millimeters
signum :: Millimeters -> Millimeters
$csignum :: Millimeters -> Millimeters
abs :: Millimeters -> Millimeters
$cabs :: Millimeters -> Millimeters
negate :: Millimeters -> Millimeters
$cnegate :: Millimeters -> Millimeters
* :: Millimeters -> Millimeters -> Millimeters
$c* :: Millimeters -> Millimeters -> Millimeters
- :: Millimeters -> Millimeters -> Millimeters
$c- :: Millimeters -> Millimeters -> Millimeters
+ :: Millimeters -> Millimeters -> Millimeters
$c+ :: Millimeters -> Millimeters -> Millimeters
Num,Num Millimeters
Ord Millimeters
Num Millimeters
-> Ord Millimeters -> (Millimeters -> Rational) -> Real Millimeters
Millimeters -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Millimeters -> Rational
$ctoRational :: Millimeters -> Rational
$cp2Real :: Ord Millimeters
$cp1Real :: Num Millimeters
Real,Num Millimeters
Num Millimeters
-> (Millimeters -> Millimeters -> Millimeters)
-> (Millimeters -> Millimeters)
-> (Rational -> Millimeters)
-> Fractional Millimeters
Rational -> Millimeters
Millimeters -> Millimeters
Millimeters -> Millimeters -> Millimeters
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Millimeters
$cfromRational :: Rational -> Millimeters
recip :: Millimeters -> Millimeters
$crecip :: Millimeters -> Millimeters
/ :: Millimeters -> Millimeters -> Millimeters
$c/ :: Millimeters -> Millimeters -> Millimeters
$cp1Fractional :: Num Millimeters
Fractional,Fractional Millimeters
Real Millimeters
Real Millimeters
-> Fractional Millimeters
-> (forall b. Integral b => Millimeters -> (b, Millimeters))
-> (forall b. Integral b => Millimeters -> b)
-> (forall b. Integral b => Millimeters -> b)
-> (forall b. Integral b => Millimeters -> b)
-> (forall b. Integral b => Millimeters -> b)
-> RealFrac Millimeters
Millimeters -> b
Millimeters -> b
Millimeters -> b
Millimeters -> b
Millimeters -> (b, Millimeters)
forall b. Integral b => Millimeters -> b
forall b. Integral b => Millimeters -> (b, Millimeters)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Millimeters -> b
$cfloor :: forall b. Integral b => Millimeters -> b
ceiling :: Millimeters -> b
$cceiling :: forall b. Integral b => Millimeters -> b
round :: Millimeters -> b
$cround :: forall b. Integral b => Millimeters -> b
truncate :: Millimeters -> b
$ctruncate :: forall b. Integral b => Millimeters -> b
properFraction :: Millimeters -> (b, Millimeters)
$cproperFraction :: forall b. Integral b => Millimeters -> (b, Millimeters)
$cp2RealFrac :: Fractional Millimeters
$cp1RealFrac :: Real Millimeters
RealFrac)
instance Show Millimeters where show :: Millimeters -> String
show (Millimeters Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read Millimeters where readsPrec :: Int -> ReadS Millimeters
readsPrec Int
i = ((Decimal, String) -> (Millimeters, String))
-> [(Decimal, String)] -> [(Millimeters, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> Millimeters)
-> (Decimal, String) -> (Millimeters, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> Millimeters
Millimeters) ([(Decimal, String)] -> [(Millimeters, String)])
-> (String -> [(Decimal, String)]) -> ReadS Millimeters
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Millimeters where
    emitXml :: Millimeters -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (Millimeters -> Decimal) -> Millimeters -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Millimeters -> Decimal
millimeters
parseMillimeters :: String -> P.XParse Millimeters
parseMillimeters :: String -> XParse Millimeters
parseMillimeters = String -> String -> XParse Millimeters
forall a. Read a => String -> String -> XParse a
P.xread String
"Millimeters"

-- | @mode@ /(simple)/
--
-- The mode type is used to specify major/minor and other mode distinctions. Valid mode values include major, minor, dorian, phrygian, lydian, mixolydian, aeolian, ionian, locrian, and none.
newtype Mode = Mode { Mode -> String
mode :: String }
    deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq,Typeable,(forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic,Eq Mode
Eq Mode
-> (Mode -> Mode -> Ordering)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Bool)
-> (Mode -> Mode -> Mode)
-> (Mode -> Mode -> Mode)
-> Ord Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
$cp1Ord :: Eq Mode
Ord,String -> Mode
(String -> Mode) -> IsString Mode
forall a. (String -> a) -> IsString a
fromString :: String -> Mode
$cfromString :: String -> Mode
IsString)
instance Show Mode where show :: Mode -> String
show (Mode String
a) = ShowS
forall a. Show a => a -> String
show String
a
instance Read Mode where readsPrec :: Int -> ReadS Mode
readsPrec Int
i = ((String, String) -> (Mode, String))
-> [(String, String)] -> [(Mode, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Mode) -> (String, String) -> (Mode, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first String -> Mode
Mode) ([(String, String)] -> [(Mode, String)])
-> (String -> [(String, String)]) -> ReadS Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(String, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Mode where
    emitXml :: Mode -> XmlRep
emitXml = String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (String -> XmlRep) -> (Mode -> String) -> Mode -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> String
mode
parseMode :: String -> P.XParse Mode
parseMode :: String -> XParse Mode
parseMode = Mode -> XParse Mode
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode -> XParse Mode) -> (String -> Mode) -> String -> XParse Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Mode
forall a. IsString a => String -> a
fromString

-- | @mute@ /(simple)/
--
-- The mute type represents muting for different instruments, including brass, winds, and strings. The on and off values are used for undifferentiated mutes. The remaining values represent specific mutes.
data Mute = 
      MuteOn -- ^ /on/
    | MuteOff -- ^ /off/
    | MuteStraight -- ^ /straight/
    | MuteCup -- ^ /cup/
    | MuteHarmonNoStem -- ^ /harmon-no-stem/
    | MuteHarmonStem -- ^ /harmon-stem/
    | MuteBucket -- ^ /bucket/
    | MutePlunger -- ^ /plunger/
    | MuteHat -- ^ /hat/
    | MuteSolotone -- ^ /solotone/
    | MutePractice -- ^ /practice/
    | MuteStopMute -- ^ /stop-mute/
    | MuteStopHand -- ^ /stop-hand/
    | MuteEcho -- ^ /echo/
    | MutePalm -- ^ /palm/
    deriving (Mute -> Mute -> Bool
(Mute -> Mute -> Bool) -> (Mute -> Mute -> Bool) -> Eq Mute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mute -> Mute -> Bool
$c/= :: Mute -> Mute -> Bool
== :: Mute -> Mute -> Bool
$c== :: Mute -> Mute -> Bool
Eq,Typeable,(forall x. Mute -> Rep Mute x)
-> (forall x. Rep Mute x -> Mute) -> Generic Mute
forall x. Rep Mute x -> Mute
forall x. Mute -> Rep Mute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mute x -> Mute
$cfrom :: forall x. Mute -> Rep Mute x
Generic,Int -> Mute -> ShowS
[Mute] -> ShowS
Mute -> String
(Int -> Mute -> ShowS)
-> (Mute -> String) -> ([Mute] -> ShowS) -> Show Mute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mute] -> ShowS
$cshowList :: [Mute] -> ShowS
show :: Mute -> String
$cshow :: Mute -> String
showsPrec :: Int -> Mute -> ShowS
$cshowsPrec :: Int -> Mute -> ShowS
Show,Eq Mute
Eq Mute
-> (Mute -> Mute -> Ordering)
-> (Mute -> Mute -> Bool)
-> (Mute -> Mute -> Bool)
-> (Mute -> Mute -> Bool)
-> (Mute -> Mute -> Bool)
-> (Mute -> Mute -> Mute)
-> (Mute -> Mute -> Mute)
-> Ord Mute
Mute -> Mute -> Bool
Mute -> Mute -> Ordering
Mute -> Mute -> Mute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mute -> Mute -> Mute
$cmin :: Mute -> Mute -> Mute
max :: Mute -> Mute -> Mute
$cmax :: Mute -> Mute -> Mute
>= :: Mute -> Mute -> Bool
$c>= :: Mute -> Mute -> Bool
> :: Mute -> Mute -> Bool
$c> :: Mute -> Mute -> Bool
<= :: Mute -> Mute -> Bool
$c<= :: Mute -> Mute -> Bool
< :: Mute -> Mute -> Bool
$c< :: Mute -> Mute -> Bool
compare :: Mute -> Mute -> Ordering
$ccompare :: Mute -> Mute -> Ordering
$cp1Ord :: Eq Mute
Ord,Int -> Mute
Mute -> Int
Mute -> [Mute]
Mute -> Mute
Mute -> Mute -> [Mute]
Mute -> Mute -> Mute -> [Mute]
(Mute -> Mute)
-> (Mute -> Mute)
-> (Int -> Mute)
-> (Mute -> Int)
-> (Mute -> [Mute])
-> (Mute -> Mute -> [Mute])
-> (Mute -> Mute -> [Mute])
-> (Mute -> Mute -> Mute -> [Mute])
-> Enum Mute
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mute -> Mute -> Mute -> [Mute]
$cenumFromThenTo :: Mute -> Mute -> Mute -> [Mute]
enumFromTo :: Mute -> Mute -> [Mute]
$cenumFromTo :: Mute -> Mute -> [Mute]
enumFromThen :: Mute -> Mute -> [Mute]
$cenumFromThen :: Mute -> Mute -> [Mute]
enumFrom :: Mute -> [Mute]
$cenumFrom :: Mute -> [Mute]
fromEnum :: Mute -> Int
$cfromEnum :: Mute -> Int
toEnum :: Int -> Mute
$ctoEnum :: Int -> Mute
pred :: Mute -> Mute
$cpred :: Mute -> Mute
succ :: Mute -> Mute
$csucc :: Mute -> Mute
Enum,Mute
Mute -> Mute -> Bounded Mute
forall a. a -> a -> Bounded a
maxBound :: Mute
$cmaxBound :: Mute
minBound :: Mute
$cminBound :: Mute
Bounded)
instance EmitXml Mute where
    emitXml :: Mute -> XmlRep
emitXml Mute
MuteOn = String -> XmlRep
XLit String
"on"
    emitXml Mute
MuteOff = String -> XmlRep
XLit String
"off"
    emitXml Mute
MuteStraight = String -> XmlRep
XLit String
"straight"
    emitXml Mute
MuteCup = String -> XmlRep
XLit String
"cup"
    emitXml Mute
MuteHarmonNoStem = String -> XmlRep
XLit String
"harmon-no-stem"
    emitXml Mute
MuteHarmonStem = String -> XmlRep
XLit String
"harmon-stem"
    emitXml Mute
MuteBucket = String -> XmlRep
XLit String
"bucket"
    emitXml Mute
MutePlunger = String -> XmlRep
XLit String
"plunger"
    emitXml Mute
MuteHat = String -> XmlRep
XLit String
"hat"
    emitXml Mute
MuteSolotone = String -> XmlRep
XLit String
"solotone"
    emitXml Mute
MutePractice = String -> XmlRep
XLit String
"practice"
    emitXml Mute
MuteStopMute = String -> XmlRep
XLit String
"stop-mute"
    emitXml Mute
MuteStopHand = String -> XmlRep
XLit String
"stop-hand"
    emitXml Mute
MuteEcho = String -> XmlRep
XLit String
"echo"
    emitXml Mute
MutePalm = String -> XmlRep
XLit String
"palm"
parseMute :: String -> P.XParse Mute
parseMute :: String -> XParse Mute
parseMute String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"on" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteOn
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"off" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteOff
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"straight" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteStraight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cup" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteCup
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"harmon-no-stem" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteHarmonNoStem
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"harmon-stem" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteHarmonStem
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bucket" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteBucket
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"plunger" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MutePlunger
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hat" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteHat
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"solotone" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteSolotone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"practice" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MutePractice
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop-mute" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteStopMute
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop-hand" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteStopHand
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"echo" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MuteEcho
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"palm" = Mute -> XParse Mute
forall (m :: * -> *) a. Monad m => a -> m a
return (Mute -> XParse Mute) -> Mute -> XParse Mute
forall a b. (a -> b) -> a -> b
$ Mute
MutePalm
        | Bool
otherwise = String -> XParse Mute
forall a. String -> XParse a
P.xfail (String -> XParse Mute) -> String -> XParse Mute
forall a b. (a -> b) -> a -> b
$ String
"Mute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @non-negative-decimal@ /(simple)/
--
-- The non-negative-decimal type specifies a non-negative decimal value.
newtype NonNegativeDecimal = NonNegativeDecimal { NonNegativeDecimal -> Decimal
nonNegativeDecimal :: Decimal }
    deriving (NonNegativeDecimal -> NonNegativeDecimal -> Bool
(NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> (NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> Eq NonNegativeDecimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c/= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
== :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c== :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
Eq,Typeable,(forall x. NonNegativeDecimal -> Rep NonNegativeDecimal x)
-> (forall x. Rep NonNegativeDecimal x -> NonNegativeDecimal)
-> Generic NonNegativeDecimal
forall x. Rep NonNegativeDecimal x -> NonNegativeDecimal
forall x. NonNegativeDecimal -> Rep NonNegativeDecimal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonNegativeDecimal x -> NonNegativeDecimal
$cfrom :: forall x. NonNegativeDecimal -> Rep NonNegativeDecimal x
Generic,Eq NonNegativeDecimal
Eq NonNegativeDecimal
-> (NonNegativeDecimal -> NonNegativeDecimal -> Ordering)
-> (NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> (NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> (NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> (NonNegativeDecimal -> NonNegativeDecimal -> Bool)
-> (NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> Ord NonNegativeDecimal
NonNegativeDecimal -> NonNegativeDecimal -> Bool
NonNegativeDecimal -> NonNegativeDecimal -> Ordering
NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$cmin :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
max :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$cmax :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
>= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c>= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
> :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c> :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
<= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c<= :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
< :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
$c< :: NonNegativeDecimal -> NonNegativeDecimal -> Bool
compare :: NonNegativeDecimal -> NonNegativeDecimal -> Ordering
$ccompare :: NonNegativeDecimal -> NonNegativeDecimal -> Ordering
$cp1Ord :: Eq NonNegativeDecimal
Ord,Integer -> NonNegativeDecimal
NonNegativeDecimal -> NonNegativeDecimal
NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
(NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal)
-> (Integer -> NonNegativeDecimal)
-> Num NonNegativeDecimal
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NonNegativeDecimal
$cfromInteger :: Integer -> NonNegativeDecimal
signum :: NonNegativeDecimal -> NonNegativeDecimal
$csignum :: NonNegativeDecimal -> NonNegativeDecimal
abs :: NonNegativeDecimal -> NonNegativeDecimal
$cabs :: NonNegativeDecimal -> NonNegativeDecimal
negate :: NonNegativeDecimal -> NonNegativeDecimal
$cnegate :: NonNegativeDecimal -> NonNegativeDecimal
* :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$c* :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
- :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$c- :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
+ :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$c+ :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
Num,Num NonNegativeDecimal
Ord NonNegativeDecimal
Num NonNegativeDecimal
-> Ord NonNegativeDecimal
-> (NonNegativeDecimal -> Rational)
-> Real NonNegativeDecimal
NonNegativeDecimal -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NonNegativeDecimal -> Rational
$ctoRational :: NonNegativeDecimal -> Rational
$cp2Real :: Ord NonNegativeDecimal
$cp1Real :: Num NonNegativeDecimal
Real,Num NonNegativeDecimal
Num NonNegativeDecimal
-> (NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal)
-> (NonNegativeDecimal -> NonNegativeDecimal)
-> (Rational -> NonNegativeDecimal)
-> Fractional NonNegativeDecimal
Rational -> NonNegativeDecimal
NonNegativeDecimal -> NonNegativeDecimal
NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> NonNegativeDecimal
$cfromRational :: Rational -> NonNegativeDecimal
recip :: NonNegativeDecimal -> NonNegativeDecimal
$crecip :: NonNegativeDecimal -> NonNegativeDecimal
/ :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$c/ :: NonNegativeDecimal -> NonNegativeDecimal -> NonNegativeDecimal
$cp1Fractional :: Num NonNegativeDecimal
Fractional,Fractional NonNegativeDecimal
Real NonNegativeDecimal
Real NonNegativeDecimal
-> Fractional NonNegativeDecimal
-> (forall b.
    Integral b =>
    NonNegativeDecimal -> (b, NonNegativeDecimal))
-> (forall b. Integral b => NonNegativeDecimal -> b)
-> (forall b. Integral b => NonNegativeDecimal -> b)
-> (forall b. Integral b => NonNegativeDecimal -> b)
-> (forall b. Integral b => NonNegativeDecimal -> b)
-> RealFrac NonNegativeDecimal
NonNegativeDecimal -> b
NonNegativeDecimal -> b
NonNegativeDecimal -> b
NonNegativeDecimal -> b
NonNegativeDecimal -> (b, NonNegativeDecimal)
forall b. Integral b => NonNegativeDecimal -> b
forall b.
Integral b =>
NonNegativeDecimal -> (b, NonNegativeDecimal)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: NonNegativeDecimal -> b
$cfloor :: forall b. Integral b => NonNegativeDecimal -> b
ceiling :: NonNegativeDecimal -> b
$cceiling :: forall b. Integral b => NonNegativeDecimal -> b
round :: NonNegativeDecimal -> b
$cround :: forall b. Integral b => NonNegativeDecimal -> b
truncate :: NonNegativeDecimal -> b
$ctruncate :: forall b. Integral b => NonNegativeDecimal -> b
properFraction :: NonNegativeDecimal -> (b, NonNegativeDecimal)
$cproperFraction :: forall b.
Integral b =>
NonNegativeDecimal -> (b, NonNegativeDecimal)
$cp2RealFrac :: Fractional NonNegativeDecimal
$cp1RealFrac :: Real NonNegativeDecimal
RealFrac)
instance Show NonNegativeDecimal where show :: NonNegativeDecimal -> String
show (NonNegativeDecimal Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read NonNegativeDecimal where readsPrec :: Int -> ReadS NonNegativeDecimal
readsPrec Int
i = ((Decimal, String) -> (NonNegativeDecimal, String))
-> [(Decimal, String)] -> [(NonNegativeDecimal, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> NonNegativeDecimal)
-> (Decimal, String) -> (NonNegativeDecimal, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> NonNegativeDecimal
NonNegativeDecimal) ([(Decimal, String)] -> [(NonNegativeDecimal, String)])
-> (String -> [(Decimal, String)]) -> ReadS NonNegativeDecimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NonNegativeDecimal where
    emitXml :: NonNegativeDecimal -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (NonNegativeDecimal -> Decimal) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegativeDecimal -> Decimal
nonNegativeDecimal
parseNonNegativeDecimal :: String -> P.XParse NonNegativeDecimal
parseNonNegativeDecimal :: String -> XParse NonNegativeDecimal
parseNonNegativeDecimal = String -> String -> XParse NonNegativeDecimal
forall a. Read a => String -> String -> XParse a
P.xread String
"NonNegativeDecimal"

-- | @xs:nonNegativeInteger@ /(simple)/
newtype NonNegativeInteger = NonNegativeInteger { NonNegativeInteger -> Int
nonNegativeInteger :: Int }
    deriving (NonNegativeInteger -> NonNegativeInteger -> Bool
(NonNegativeInteger -> NonNegativeInteger -> Bool)
-> (NonNegativeInteger -> NonNegativeInteger -> Bool)
-> Eq NonNegativeInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c/= :: NonNegativeInteger -> NonNegativeInteger -> Bool
== :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c== :: NonNegativeInteger -> NonNegativeInteger -> Bool
Eq,Typeable,(forall x. NonNegativeInteger -> Rep NonNegativeInteger x)
-> (forall x. Rep NonNegativeInteger x -> NonNegativeInteger)
-> Generic NonNegativeInteger
forall x. Rep NonNegativeInteger x -> NonNegativeInteger
forall x. NonNegativeInteger -> Rep NonNegativeInteger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonNegativeInteger x -> NonNegativeInteger
$cfrom :: forall x. NonNegativeInteger -> Rep NonNegativeInteger x
Generic,Eq NonNegativeInteger
Eq NonNegativeInteger
-> (NonNegativeInteger -> NonNegativeInteger -> Ordering)
-> (NonNegativeInteger -> NonNegativeInteger -> Bool)
-> (NonNegativeInteger -> NonNegativeInteger -> Bool)
-> (NonNegativeInteger -> NonNegativeInteger -> Bool)
-> (NonNegativeInteger -> NonNegativeInteger -> Bool)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> Ord NonNegativeInteger
NonNegativeInteger -> NonNegativeInteger -> Bool
NonNegativeInteger -> NonNegativeInteger -> Ordering
NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cmin :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
max :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cmax :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
>= :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c>= :: NonNegativeInteger -> NonNegativeInteger -> Bool
> :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c> :: NonNegativeInteger -> NonNegativeInteger -> Bool
<= :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c<= :: NonNegativeInteger -> NonNegativeInteger -> Bool
< :: NonNegativeInteger -> NonNegativeInteger -> Bool
$c< :: NonNegativeInteger -> NonNegativeInteger -> Bool
compare :: NonNegativeInteger -> NonNegativeInteger -> Ordering
$ccompare :: NonNegativeInteger -> NonNegativeInteger -> Ordering
$cp1Ord :: Eq NonNegativeInteger
Ord,NonNegativeInteger
NonNegativeInteger
-> NonNegativeInteger -> Bounded NonNegativeInteger
forall a. a -> a -> Bounded a
maxBound :: NonNegativeInteger
$cmaxBound :: NonNegativeInteger
minBound :: NonNegativeInteger
$cminBound :: NonNegativeInteger
Bounded,Int -> NonNegativeInteger
NonNegativeInteger -> Int
NonNegativeInteger -> [NonNegativeInteger]
NonNegativeInteger -> NonNegativeInteger
NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
NonNegativeInteger
-> NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
(NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger)
-> (Int -> NonNegativeInteger)
-> (NonNegativeInteger -> Int)
-> (NonNegativeInteger -> [NonNegativeInteger])
-> (NonNegativeInteger
    -> NonNegativeInteger -> [NonNegativeInteger])
-> (NonNegativeInteger
    -> NonNegativeInteger -> [NonNegativeInteger])
-> (NonNegativeInteger
    -> NonNegativeInteger
    -> NonNegativeInteger
    -> [NonNegativeInteger])
-> Enum NonNegativeInteger
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NonNegativeInteger
-> NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
$cenumFromThenTo :: NonNegativeInteger
-> NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
enumFromTo :: NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
$cenumFromTo :: NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
enumFromThen :: NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
$cenumFromThen :: NonNegativeInteger -> NonNegativeInteger -> [NonNegativeInteger]
enumFrom :: NonNegativeInteger -> [NonNegativeInteger]
$cenumFrom :: NonNegativeInteger -> [NonNegativeInteger]
fromEnum :: NonNegativeInteger -> Int
$cfromEnum :: NonNegativeInteger -> Int
toEnum :: Int -> NonNegativeInteger
$ctoEnum :: Int -> NonNegativeInteger
pred :: NonNegativeInteger -> NonNegativeInteger
$cpred :: NonNegativeInteger -> NonNegativeInteger
succ :: NonNegativeInteger -> NonNegativeInteger
$csucc :: NonNegativeInteger -> NonNegativeInteger
Enum,Integer -> NonNegativeInteger
NonNegativeInteger -> NonNegativeInteger
NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
(NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger)
-> (Integer -> NonNegativeInteger)
-> Num NonNegativeInteger
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NonNegativeInteger
$cfromInteger :: Integer -> NonNegativeInteger
signum :: NonNegativeInteger -> NonNegativeInteger
$csignum :: NonNegativeInteger -> NonNegativeInteger
abs :: NonNegativeInteger -> NonNegativeInteger
$cabs :: NonNegativeInteger -> NonNegativeInteger
negate :: NonNegativeInteger -> NonNegativeInteger
$cnegate :: NonNegativeInteger -> NonNegativeInteger
* :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$c* :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
- :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$c- :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
+ :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$c+ :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
Num,Num NonNegativeInteger
Ord NonNegativeInteger
Num NonNegativeInteger
-> Ord NonNegativeInteger
-> (NonNegativeInteger -> Rational)
-> Real NonNegativeInteger
NonNegativeInteger -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NonNegativeInteger -> Rational
$ctoRational :: NonNegativeInteger -> Rational
$cp2Real :: Ord NonNegativeInteger
$cp1Real :: Num NonNegativeInteger
Real,Enum NonNegativeInteger
Real NonNegativeInteger
Real NonNegativeInteger
-> Enum NonNegativeInteger
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger)
-> (NonNegativeInteger
    -> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger))
-> (NonNegativeInteger
    -> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger))
-> (NonNegativeInteger -> Integer)
-> Integral NonNegativeInteger
NonNegativeInteger -> Integer
NonNegativeInteger
-> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger)
NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: NonNegativeInteger -> Integer
$ctoInteger :: NonNegativeInteger -> Integer
divMod :: NonNegativeInteger
-> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger)
$cdivMod :: NonNegativeInteger
-> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger)
quotRem :: NonNegativeInteger
-> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger)
$cquotRem :: NonNegativeInteger
-> NonNegativeInteger -> (NonNegativeInteger, NonNegativeInteger)
mod :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cmod :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
div :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cdiv :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
rem :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$crem :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
quot :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cquot :: NonNegativeInteger -> NonNegativeInteger -> NonNegativeInteger
$cp2Integral :: Enum NonNegativeInteger
$cp1Integral :: Real NonNegativeInteger
Integral)
instance Show NonNegativeInteger where show :: NonNegativeInteger -> String
show (NonNegativeInteger Int
a) = Int -> String
forall a. Show a => a -> String
show Int
a
instance Read NonNegativeInteger where readsPrec :: Int -> ReadS NonNegativeInteger
readsPrec Int
i = ((Int, String) -> (NonNegativeInteger, String))
-> [(Int, String)] -> [(NonNegativeInteger, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> NonNegativeInteger)
-> (Int, String) -> (NonNegativeInteger, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Int -> NonNegativeInteger
NonNegativeInteger) ([(Int, String)] -> [(NonNegativeInteger, String)])
-> (String -> [(Int, String)]) -> ReadS NonNegativeInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NonNegativeInteger where
    emitXml :: NonNegativeInteger -> XmlRep
emitXml = Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Int -> XmlRep)
-> (NonNegativeInteger -> Int) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegativeInteger -> Int
nonNegativeInteger
parseNonNegativeInteger :: String -> P.XParse NonNegativeInteger
parseNonNegativeInteger :: String -> XParse NonNegativeInteger
parseNonNegativeInteger = String -> String -> XParse NonNegativeInteger
forall a. Read a => String -> String -> XParse a
P.xread String
"NonNegativeInteger"

-- | @xs:normalizedString@ /(simple)/
newtype NormalizedString = NormalizedString { NormalizedString -> String
normalizedString :: String }
    deriving (NormalizedString -> NormalizedString -> Bool
(NormalizedString -> NormalizedString -> Bool)
-> (NormalizedString -> NormalizedString -> Bool)
-> Eq NormalizedString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalizedString -> NormalizedString -> Bool
$c/= :: NormalizedString -> NormalizedString -> Bool
== :: NormalizedString -> NormalizedString -> Bool
$c== :: NormalizedString -> NormalizedString -> Bool
Eq,Typeable,(forall x. NormalizedString -> Rep NormalizedString x)
-> (forall x. Rep NormalizedString x -> NormalizedString)
-> Generic NormalizedString
forall x. Rep NormalizedString x -> NormalizedString
forall x. NormalizedString -> Rep NormalizedString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NormalizedString x -> NormalizedString
$cfrom :: forall x. NormalizedString -> Rep NormalizedString x
Generic,Eq NormalizedString
Eq NormalizedString
-> (NormalizedString -> NormalizedString -> Ordering)
-> (NormalizedString -> NormalizedString -> Bool)
-> (NormalizedString -> NormalizedString -> Bool)
-> (NormalizedString -> NormalizedString -> Bool)
-> (NormalizedString -> NormalizedString -> Bool)
-> (NormalizedString -> NormalizedString -> NormalizedString)
-> (NormalizedString -> NormalizedString -> NormalizedString)
-> Ord NormalizedString
NormalizedString -> NormalizedString -> Bool
NormalizedString -> NormalizedString -> Ordering
NormalizedString -> NormalizedString -> NormalizedString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NormalizedString -> NormalizedString -> NormalizedString
$cmin :: NormalizedString -> NormalizedString -> NormalizedString
max :: NormalizedString -> NormalizedString -> NormalizedString
$cmax :: NormalizedString -> NormalizedString -> NormalizedString
>= :: NormalizedString -> NormalizedString -> Bool
$c>= :: NormalizedString -> NormalizedString -> Bool
> :: NormalizedString -> NormalizedString -> Bool
$c> :: NormalizedString -> NormalizedString -> Bool
<= :: NormalizedString -> NormalizedString -> Bool
$c<= :: NormalizedString -> NormalizedString -> Bool
< :: NormalizedString -> NormalizedString -> Bool
$c< :: NormalizedString -> NormalizedString -> Bool
compare :: NormalizedString -> NormalizedString -> Ordering
$ccompare :: NormalizedString -> NormalizedString -> Ordering
$cp1Ord :: Eq NormalizedString
Ord,String -> NormalizedString
(String -> NormalizedString) -> IsString NormalizedString
forall a. (String -> a) -> IsString a
fromString :: String -> NormalizedString
$cfromString :: String -> NormalizedString
IsString)
instance Show NormalizedString where show :: NormalizedString -> String
show (NormalizedString String
a) = ShowS
forall a. Show a => a -> String
show String
a
instance Read NormalizedString where readsPrec :: Int -> ReadS NormalizedString
readsPrec Int
i = ((String, String) -> (NormalizedString, String))
-> [(String, String)] -> [(NormalizedString, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> NormalizedString)
-> (String, String) -> (NormalizedString, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first String -> NormalizedString
NormalizedString) ([(String, String)] -> [(NormalizedString, String)])
-> (String -> [(String, String)]) -> ReadS NormalizedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(String, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NormalizedString where
    emitXml :: NormalizedString -> XmlRep
emitXml = String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (String -> XmlRep)
-> (NormalizedString -> String) -> NormalizedString -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedString -> String
normalizedString
parseNormalizedString :: String -> P.XParse NormalizedString
parseNormalizedString :: String -> XParse NormalizedString
parseNormalizedString = NormalizedString -> XParse NormalizedString
forall (m :: * -> *) a. Monad m => a -> m a
return (NormalizedString -> XParse NormalizedString)
-> (String -> NormalizedString)
-> String
-> XParse NormalizedString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NormalizedString
forall a. IsString a => String -> a
fromString

-- | @note-size-type@ /(simple)/
--
-- The note-size-type type indicates the type of note being defined by a note-size element. The grace-cue type is used for notes of grace-cue size. The grace type is used for notes of cue size that include a grace element. The cue type is used for all other notes with cue size, whether defined explicitly or implicitly via a cue element. The large type is used for notes of large size.
data NoteSizeType = 
      NoteSizeTypeCue -- ^ /cue/
    | NoteSizeTypeGrace -- ^ /grace/
    | NoteSizeTypeGraceCue -- ^ /grace-cue/
    | NoteSizeTypeLarge -- ^ /large/
    deriving (NoteSizeType -> NoteSizeType -> Bool
(NoteSizeType -> NoteSizeType -> Bool)
-> (NoteSizeType -> NoteSizeType -> Bool) -> Eq NoteSizeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteSizeType -> NoteSizeType -> Bool
$c/= :: NoteSizeType -> NoteSizeType -> Bool
== :: NoteSizeType -> NoteSizeType -> Bool
$c== :: NoteSizeType -> NoteSizeType -> Bool
Eq,Typeable,(forall x. NoteSizeType -> Rep NoteSizeType x)
-> (forall x. Rep NoteSizeType x -> NoteSizeType)
-> Generic NoteSizeType
forall x. Rep NoteSizeType x -> NoteSizeType
forall x. NoteSizeType -> Rep NoteSizeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteSizeType x -> NoteSizeType
$cfrom :: forall x. NoteSizeType -> Rep NoteSizeType x
Generic,Int -> NoteSizeType -> ShowS
[NoteSizeType] -> ShowS
NoteSizeType -> String
(Int -> NoteSizeType -> ShowS)
-> (NoteSizeType -> String)
-> ([NoteSizeType] -> ShowS)
-> Show NoteSizeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteSizeType] -> ShowS
$cshowList :: [NoteSizeType] -> ShowS
show :: NoteSizeType -> String
$cshow :: NoteSizeType -> String
showsPrec :: Int -> NoteSizeType -> ShowS
$cshowsPrec :: Int -> NoteSizeType -> ShowS
Show,Eq NoteSizeType
Eq NoteSizeType
-> (NoteSizeType -> NoteSizeType -> Ordering)
-> (NoteSizeType -> NoteSizeType -> Bool)
-> (NoteSizeType -> NoteSizeType -> Bool)
-> (NoteSizeType -> NoteSizeType -> Bool)
-> (NoteSizeType -> NoteSizeType -> Bool)
-> (NoteSizeType -> NoteSizeType -> NoteSizeType)
-> (NoteSizeType -> NoteSizeType -> NoteSizeType)
-> Ord NoteSizeType
NoteSizeType -> NoteSizeType -> Bool
NoteSizeType -> NoteSizeType -> Ordering
NoteSizeType -> NoteSizeType -> NoteSizeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NoteSizeType -> NoteSizeType -> NoteSizeType
$cmin :: NoteSizeType -> NoteSizeType -> NoteSizeType
max :: NoteSizeType -> NoteSizeType -> NoteSizeType
$cmax :: NoteSizeType -> NoteSizeType -> NoteSizeType
>= :: NoteSizeType -> NoteSizeType -> Bool
$c>= :: NoteSizeType -> NoteSizeType -> Bool
> :: NoteSizeType -> NoteSizeType -> Bool
$c> :: NoteSizeType -> NoteSizeType -> Bool
<= :: NoteSizeType -> NoteSizeType -> Bool
$c<= :: NoteSizeType -> NoteSizeType -> Bool
< :: NoteSizeType -> NoteSizeType -> Bool
$c< :: NoteSizeType -> NoteSizeType -> Bool
compare :: NoteSizeType -> NoteSizeType -> Ordering
$ccompare :: NoteSizeType -> NoteSizeType -> Ordering
$cp1Ord :: Eq NoteSizeType
Ord,Int -> NoteSizeType
NoteSizeType -> Int
NoteSizeType -> [NoteSizeType]
NoteSizeType -> NoteSizeType
NoteSizeType -> NoteSizeType -> [NoteSizeType]
NoteSizeType -> NoteSizeType -> NoteSizeType -> [NoteSizeType]
(NoteSizeType -> NoteSizeType)
-> (NoteSizeType -> NoteSizeType)
-> (Int -> NoteSizeType)
-> (NoteSizeType -> Int)
-> (NoteSizeType -> [NoteSizeType])
-> (NoteSizeType -> NoteSizeType -> [NoteSizeType])
-> (NoteSizeType -> NoteSizeType -> [NoteSizeType])
-> (NoteSizeType -> NoteSizeType -> NoteSizeType -> [NoteSizeType])
-> Enum NoteSizeType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NoteSizeType -> NoteSizeType -> NoteSizeType -> [NoteSizeType]
$cenumFromThenTo :: NoteSizeType -> NoteSizeType -> NoteSizeType -> [NoteSizeType]
enumFromTo :: NoteSizeType -> NoteSizeType -> [NoteSizeType]
$cenumFromTo :: NoteSizeType -> NoteSizeType -> [NoteSizeType]
enumFromThen :: NoteSizeType -> NoteSizeType -> [NoteSizeType]
$cenumFromThen :: NoteSizeType -> NoteSizeType -> [NoteSizeType]
enumFrom :: NoteSizeType -> [NoteSizeType]
$cenumFrom :: NoteSizeType -> [NoteSizeType]
fromEnum :: NoteSizeType -> Int
$cfromEnum :: NoteSizeType -> Int
toEnum :: Int -> NoteSizeType
$ctoEnum :: Int -> NoteSizeType
pred :: NoteSizeType -> NoteSizeType
$cpred :: NoteSizeType -> NoteSizeType
succ :: NoteSizeType -> NoteSizeType
$csucc :: NoteSizeType -> NoteSizeType
Enum,NoteSizeType
NoteSizeType -> NoteSizeType -> Bounded NoteSizeType
forall a. a -> a -> Bounded a
maxBound :: NoteSizeType
$cmaxBound :: NoteSizeType
minBound :: NoteSizeType
$cminBound :: NoteSizeType
Bounded)
instance EmitXml NoteSizeType where
    emitXml :: NoteSizeType -> XmlRep
emitXml NoteSizeType
NoteSizeTypeCue = String -> XmlRep
XLit String
"cue"
    emitXml NoteSizeType
NoteSizeTypeGrace = String -> XmlRep
XLit String
"grace"
    emitXml NoteSizeType
NoteSizeTypeGraceCue = String -> XmlRep
XLit String
"grace-cue"
    emitXml NoteSizeType
NoteSizeTypeLarge = String -> XmlRep
XLit String
"large"
parseNoteSizeType :: String -> P.XParse NoteSizeType
parseNoteSizeType :: String -> XParse NoteSizeType
parseNoteSizeType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cue" = NoteSizeType -> XParse NoteSizeType
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteSizeType -> XParse NoteSizeType)
-> NoteSizeType -> XParse NoteSizeType
forall a b. (a -> b) -> a -> b
$ NoteSizeType
NoteSizeTypeCue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"grace" = NoteSizeType -> XParse NoteSizeType
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteSizeType -> XParse NoteSizeType)
-> NoteSizeType -> XParse NoteSizeType
forall a b. (a -> b) -> a -> b
$ NoteSizeType
NoteSizeTypeGrace
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"grace-cue" = NoteSizeType -> XParse NoteSizeType
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteSizeType -> XParse NoteSizeType)
-> NoteSizeType -> XParse NoteSizeType
forall a b. (a -> b) -> a -> b
$ NoteSizeType
NoteSizeTypeGraceCue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"large" = NoteSizeType -> XParse NoteSizeType
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteSizeType -> XParse NoteSizeType)
-> NoteSizeType -> XParse NoteSizeType
forall a b. (a -> b) -> a -> b
$ NoteSizeType
NoteSizeTypeLarge
        | Bool
otherwise = String -> XParse NoteSizeType
forall a. String -> XParse a
P.xfail (String -> XParse NoteSizeType) -> String -> XParse NoteSizeType
forall a b. (a -> b) -> a -> b
$ String
"NoteSizeType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @note-type-value@ /(simple)/
--
-- The note-type type is used for the MusicXML type element and represents the graphic note type, from 1024th (shortest) to maxima (longest).
data NoteTypeValue = 
      NoteTypeValue1024th -- ^ /1024th/
    | NoteTypeValue512th -- ^ /512th/
    | NoteTypeValue256th -- ^ /256th/
    | NoteTypeValue128th -- ^ /128th/
    | NoteTypeValue64th -- ^ /64th/
    | NoteTypeValue32nd -- ^ /32nd/
    | NoteTypeValue16th -- ^ /16th/
    | NoteTypeValueEighth -- ^ /eighth/
    | NoteTypeValueQuarter -- ^ /quarter/
    | NoteTypeValueHalf -- ^ /half/
    | NoteTypeValueWhole -- ^ /whole/
    | NoteTypeValueBreve -- ^ /breve/
    | NoteTypeValueLong -- ^ /long/
    | NoteTypeValueMaxima -- ^ /maxima/
    deriving (NoteTypeValue -> NoteTypeValue -> Bool
(NoteTypeValue -> NoteTypeValue -> Bool)
-> (NoteTypeValue -> NoteTypeValue -> Bool) -> Eq NoteTypeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteTypeValue -> NoteTypeValue -> Bool
$c/= :: NoteTypeValue -> NoteTypeValue -> Bool
== :: NoteTypeValue -> NoteTypeValue -> Bool
$c== :: NoteTypeValue -> NoteTypeValue -> Bool
Eq,Typeable,(forall x. NoteTypeValue -> Rep NoteTypeValue x)
-> (forall x. Rep NoteTypeValue x -> NoteTypeValue)
-> Generic NoteTypeValue
forall x. Rep NoteTypeValue x -> NoteTypeValue
forall x. NoteTypeValue -> Rep NoteTypeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteTypeValue x -> NoteTypeValue
$cfrom :: forall x. NoteTypeValue -> Rep NoteTypeValue x
Generic,Int -> NoteTypeValue -> ShowS
[NoteTypeValue] -> ShowS
NoteTypeValue -> String
(Int -> NoteTypeValue -> ShowS)
-> (NoteTypeValue -> String)
-> ([NoteTypeValue] -> ShowS)
-> Show NoteTypeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteTypeValue] -> ShowS
$cshowList :: [NoteTypeValue] -> ShowS
show :: NoteTypeValue -> String
$cshow :: NoteTypeValue -> String
showsPrec :: Int -> NoteTypeValue -> ShowS
$cshowsPrec :: Int -> NoteTypeValue -> ShowS
Show,Eq NoteTypeValue
Eq NoteTypeValue
-> (NoteTypeValue -> NoteTypeValue -> Ordering)
-> (NoteTypeValue -> NoteTypeValue -> Bool)
-> (NoteTypeValue -> NoteTypeValue -> Bool)
-> (NoteTypeValue -> NoteTypeValue -> Bool)
-> (NoteTypeValue -> NoteTypeValue -> Bool)
-> (NoteTypeValue -> NoteTypeValue -> NoteTypeValue)
-> (NoteTypeValue -> NoteTypeValue -> NoteTypeValue)
-> Ord NoteTypeValue
NoteTypeValue -> NoteTypeValue -> Bool
NoteTypeValue -> NoteTypeValue -> Ordering
NoteTypeValue -> NoteTypeValue -> NoteTypeValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue
$cmin :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue
max :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue
$cmax :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue
>= :: NoteTypeValue -> NoteTypeValue -> Bool
$c>= :: NoteTypeValue -> NoteTypeValue -> Bool
> :: NoteTypeValue -> NoteTypeValue -> Bool
$c> :: NoteTypeValue -> NoteTypeValue -> Bool
<= :: NoteTypeValue -> NoteTypeValue -> Bool
$c<= :: NoteTypeValue -> NoteTypeValue -> Bool
< :: NoteTypeValue -> NoteTypeValue -> Bool
$c< :: NoteTypeValue -> NoteTypeValue -> Bool
compare :: NoteTypeValue -> NoteTypeValue -> Ordering
$ccompare :: NoteTypeValue -> NoteTypeValue -> Ordering
$cp1Ord :: Eq NoteTypeValue
Ord,Int -> NoteTypeValue
NoteTypeValue -> Int
NoteTypeValue -> [NoteTypeValue]
NoteTypeValue -> NoteTypeValue
NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
NoteTypeValue -> NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
(NoteTypeValue -> NoteTypeValue)
-> (NoteTypeValue -> NoteTypeValue)
-> (Int -> NoteTypeValue)
-> (NoteTypeValue -> Int)
-> (NoteTypeValue -> [NoteTypeValue])
-> (NoteTypeValue -> NoteTypeValue -> [NoteTypeValue])
-> (NoteTypeValue -> NoteTypeValue -> [NoteTypeValue])
-> (NoteTypeValue
    -> NoteTypeValue -> NoteTypeValue -> [NoteTypeValue])
-> Enum NoteTypeValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
$cenumFromThenTo :: NoteTypeValue -> NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
enumFromTo :: NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
$cenumFromTo :: NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
enumFromThen :: NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
$cenumFromThen :: NoteTypeValue -> NoteTypeValue -> [NoteTypeValue]
enumFrom :: NoteTypeValue -> [NoteTypeValue]
$cenumFrom :: NoteTypeValue -> [NoteTypeValue]
fromEnum :: NoteTypeValue -> Int
$cfromEnum :: NoteTypeValue -> Int
toEnum :: Int -> NoteTypeValue
$ctoEnum :: Int -> NoteTypeValue
pred :: NoteTypeValue -> NoteTypeValue
$cpred :: NoteTypeValue -> NoteTypeValue
succ :: NoteTypeValue -> NoteTypeValue
$csucc :: NoteTypeValue -> NoteTypeValue
Enum,NoteTypeValue
NoteTypeValue -> NoteTypeValue -> Bounded NoteTypeValue
forall a. a -> a -> Bounded a
maxBound :: NoteTypeValue
$cmaxBound :: NoteTypeValue
minBound :: NoteTypeValue
$cminBound :: NoteTypeValue
Bounded)
instance EmitXml NoteTypeValue where
    emitXml :: NoteTypeValue -> XmlRep
emitXml NoteTypeValue
NoteTypeValue1024th = String -> XmlRep
XLit String
"1024th"
    emitXml NoteTypeValue
NoteTypeValue512th = String -> XmlRep
XLit String
"512th"
    emitXml NoteTypeValue
NoteTypeValue256th = String -> XmlRep
XLit String
"256th"
    emitXml NoteTypeValue
NoteTypeValue128th = String -> XmlRep
XLit String
"128th"
    emitXml NoteTypeValue
NoteTypeValue64th = String -> XmlRep
XLit String
"64th"
    emitXml NoteTypeValue
NoteTypeValue32nd = String -> XmlRep
XLit String
"32nd"
    emitXml NoteTypeValue
NoteTypeValue16th = String -> XmlRep
XLit String
"16th"
    emitXml NoteTypeValue
NoteTypeValueEighth = String -> XmlRep
XLit String
"eighth"
    emitXml NoteTypeValue
NoteTypeValueQuarter = String -> XmlRep
XLit String
"quarter"
    emitXml NoteTypeValue
NoteTypeValueHalf = String -> XmlRep
XLit String
"half"
    emitXml NoteTypeValue
NoteTypeValueWhole = String -> XmlRep
XLit String
"whole"
    emitXml NoteTypeValue
NoteTypeValueBreve = String -> XmlRep
XLit String
"breve"
    emitXml NoteTypeValue
NoteTypeValueLong = String -> XmlRep
XLit String
"long"
    emitXml NoteTypeValue
NoteTypeValueMaxima = String -> XmlRep
XLit String
"maxima"
parseNoteTypeValue :: String -> P.XParse NoteTypeValue
parseNoteTypeValue :: String -> XParse NoteTypeValue
parseNoteTypeValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"1024th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue1024th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"512th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue512th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"256th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue256th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"128th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue128th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"64th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue64th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"32nd" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue32nd
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"16th" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValue16th
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"eighth" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueEighth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"quarter" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueQuarter
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueHalf
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"whole" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueWhole
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"breve" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueBreve
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"long" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueLong
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"maxima" = NoteTypeValue -> XParse NoteTypeValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteTypeValue -> XParse NoteTypeValue)
-> NoteTypeValue -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ NoteTypeValue
NoteTypeValueMaxima
        | Bool
otherwise = String -> XParse NoteTypeValue
forall a. String -> XParse a
P.xfail (String -> XParse NoteTypeValue) -> String -> XParse NoteTypeValue
forall a b. (a -> b) -> a -> b
$ String
"NoteTypeValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @notehead-value@ /(simple)/
--
-- 
-- The notehead-value type indicates shapes other than the open and closed ovals associated with note durations.
-- 
-- The values do, re, mi, fa, fa up, so, la, and ti correspond to Aikin's 7-shape system.  The fa up shape is typically used with upstems; the fa shape is typically used with downstems or no stems.
-- 
-- The arrow shapes differ from triangle and inverted triangle by being centered on the stem. Slashed and back slashed notes include both the normal notehead and a slash. The triangle shape has the tip of the triangle pointing up; the inverted triangle shape has the tip of the triangle pointing down. The left triangle shape is a right triangle with the hypotenuse facing up and to the left.
-- 
-- The other notehead covers noteheads other than those listed here. It is usually used in combination with the smufl attribute to specify a particular SMuFL notehead. The smufl attribute may be used with any notehead value to help specify the appearance of symbols that share the same MusicXML semantics. Noteheads in the SMuFL "Note name noteheads" range (U+E150–U+E1AF) should not use the smufl attribute or the "other" value, but instead use the notehead-text element.
data NoteheadValue = 
      NoteheadValueSlash -- ^ /slash/
    | NoteheadValueTriangle -- ^ /triangle/
    | NoteheadValueDiamond -- ^ /diamond/
    | NoteheadValueSquare -- ^ /square/
    | NoteheadValueCross -- ^ /cross/
    | NoteheadValueX -- ^ /x/
    | NoteheadValueCircleX -- ^ /circle-x/
    | NoteheadValueInvertedTriangle -- ^ /inverted triangle/
    | NoteheadValueArrowDown -- ^ /arrow down/
    | NoteheadValueArrowUp -- ^ /arrow up/
    | NoteheadValueCircled -- ^ /circled/
    | NoteheadValueSlashed -- ^ /slashed/
    | NoteheadValueBackSlashed -- ^ /back slashed/
    | NoteheadValueNormal -- ^ /normal/
    | NoteheadValueCluster -- ^ /cluster/
    | NoteheadValueCircleDot -- ^ /circle dot/
    | NoteheadValueLeftTriangle -- ^ /left triangle/
    | NoteheadValueRectangle -- ^ /rectangle/
    | NoteheadValueNone -- ^ /none/
    | NoteheadValueDo -- ^ /do/
    | NoteheadValueRe -- ^ /re/
    | NoteheadValueMi -- ^ /mi/
    | NoteheadValueFa -- ^ /fa/
    | NoteheadValueFaUp -- ^ /fa up/
    | NoteheadValueSo -- ^ /so/
    | NoteheadValueLa -- ^ /la/
    | NoteheadValueTi -- ^ /ti/
    | NoteheadValueOther -- ^ /other/
    deriving (NoteheadValue -> NoteheadValue -> Bool
(NoteheadValue -> NoteheadValue -> Bool)
-> (NoteheadValue -> NoteheadValue -> Bool) -> Eq NoteheadValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteheadValue -> NoteheadValue -> Bool
$c/= :: NoteheadValue -> NoteheadValue -> Bool
== :: NoteheadValue -> NoteheadValue -> Bool
$c== :: NoteheadValue -> NoteheadValue -> Bool
Eq,Typeable,(forall x. NoteheadValue -> Rep NoteheadValue x)
-> (forall x. Rep NoteheadValue x -> NoteheadValue)
-> Generic NoteheadValue
forall x. Rep NoteheadValue x -> NoteheadValue
forall x. NoteheadValue -> Rep NoteheadValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteheadValue x -> NoteheadValue
$cfrom :: forall x. NoteheadValue -> Rep NoteheadValue x
Generic,Int -> NoteheadValue -> ShowS
[NoteheadValue] -> ShowS
NoteheadValue -> String
(Int -> NoteheadValue -> ShowS)
-> (NoteheadValue -> String)
-> ([NoteheadValue] -> ShowS)
-> Show NoteheadValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteheadValue] -> ShowS
$cshowList :: [NoteheadValue] -> ShowS
show :: NoteheadValue -> String
$cshow :: NoteheadValue -> String
showsPrec :: Int -> NoteheadValue -> ShowS
$cshowsPrec :: Int -> NoteheadValue -> ShowS
Show,Eq NoteheadValue
Eq NoteheadValue
-> (NoteheadValue -> NoteheadValue -> Ordering)
-> (NoteheadValue -> NoteheadValue -> Bool)
-> (NoteheadValue -> NoteheadValue -> Bool)
-> (NoteheadValue -> NoteheadValue -> Bool)
-> (NoteheadValue -> NoteheadValue -> Bool)
-> (NoteheadValue -> NoteheadValue -> NoteheadValue)
-> (NoteheadValue -> NoteheadValue -> NoteheadValue)
-> Ord NoteheadValue
NoteheadValue -> NoteheadValue -> Bool
NoteheadValue -> NoteheadValue -> Ordering
NoteheadValue -> NoteheadValue -> NoteheadValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NoteheadValue -> NoteheadValue -> NoteheadValue
$cmin :: NoteheadValue -> NoteheadValue -> NoteheadValue
max :: NoteheadValue -> NoteheadValue -> NoteheadValue
$cmax :: NoteheadValue -> NoteheadValue -> NoteheadValue
>= :: NoteheadValue -> NoteheadValue -> Bool
$c>= :: NoteheadValue -> NoteheadValue -> Bool
> :: NoteheadValue -> NoteheadValue -> Bool
$c> :: NoteheadValue -> NoteheadValue -> Bool
<= :: NoteheadValue -> NoteheadValue -> Bool
$c<= :: NoteheadValue -> NoteheadValue -> Bool
< :: NoteheadValue -> NoteheadValue -> Bool
$c< :: NoteheadValue -> NoteheadValue -> Bool
compare :: NoteheadValue -> NoteheadValue -> Ordering
$ccompare :: NoteheadValue -> NoteheadValue -> Ordering
$cp1Ord :: Eq NoteheadValue
Ord,Int -> NoteheadValue
NoteheadValue -> Int
NoteheadValue -> [NoteheadValue]
NoteheadValue -> NoteheadValue
NoteheadValue -> NoteheadValue -> [NoteheadValue]
NoteheadValue -> NoteheadValue -> NoteheadValue -> [NoteheadValue]
(NoteheadValue -> NoteheadValue)
-> (NoteheadValue -> NoteheadValue)
-> (Int -> NoteheadValue)
-> (NoteheadValue -> Int)
-> (NoteheadValue -> [NoteheadValue])
-> (NoteheadValue -> NoteheadValue -> [NoteheadValue])
-> (NoteheadValue -> NoteheadValue -> [NoteheadValue])
-> (NoteheadValue
    -> NoteheadValue -> NoteheadValue -> [NoteheadValue])
-> Enum NoteheadValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NoteheadValue -> NoteheadValue -> NoteheadValue -> [NoteheadValue]
$cenumFromThenTo :: NoteheadValue -> NoteheadValue -> NoteheadValue -> [NoteheadValue]
enumFromTo :: NoteheadValue -> NoteheadValue -> [NoteheadValue]
$cenumFromTo :: NoteheadValue -> NoteheadValue -> [NoteheadValue]
enumFromThen :: NoteheadValue -> NoteheadValue -> [NoteheadValue]
$cenumFromThen :: NoteheadValue -> NoteheadValue -> [NoteheadValue]
enumFrom :: NoteheadValue -> [NoteheadValue]
$cenumFrom :: NoteheadValue -> [NoteheadValue]
fromEnum :: NoteheadValue -> Int
$cfromEnum :: NoteheadValue -> Int
toEnum :: Int -> NoteheadValue
$ctoEnum :: Int -> NoteheadValue
pred :: NoteheadValue -> NoteheadValue
$cpred :: NoteheadValue -> NoteheadValue
succ :: NoteheadValue -> NoteheadValue
$csucc :: NoteheadValue -> NoteheadValue
Enum,NoteheadValue
NoteheadValue -> NoteheadValue -> Bounded NoteheadValue
forall a. a -> a -> Bounded a
maxBound :: NoteheadValue
$cmaxBound :: NoteheadValue
minBound :: NoteheadValue
$cminBound :: NoteheadValue
Bounded)
instance EmitXml NoteheadValue where
    emitXml :: NoteheadValue -> XmlRep
emitXml NoteheadValue
NoteheadValueSlash = String -> XmlRep
XLit String
"slash"
    emitXml NoteheadValue
NoteheadValueTriangle = String -> XmlRep
XLit String
"triangle"
    emitXml NoteheadValue
NoteheadValueDiamond = String -> XmlRep
XLit String
"diamond"
    emitXml NoteheadValue
NoteheadValueSquare = String -> XmlRep
XLit String
"square"
    emitXml NoteheadValue
NoteheadValueCross = String -> XmlRep
XLit String
"cross"
    emitXml NoteheadValue
NoteheadValueX = String -> XmlRep
XLit String
"x"
    emitXml NoteheadValue
NoteheadValueCircleX = String -> XmlRep
XLit String
"circle-x"
    emitXml NoteheadValue
NoteheadValueInvertedTriangle = String -> XmlRep
XLit String
"inverted triangle"
    emitXml NoteheadValue
NoteheadValueArrowDown = String -> XmlRep
XLit String
"arrow down"
    emitXml NoteheadValue
NoteheadValueArrowUp = String -> XmlRep
XLit String
"arrow up"
    emitXml NoteheadValue
NoteheadValueCircled = String -> XmlRep
XLit String
"circled"
    emitXml NoteheadValue
NoteheadValueSlashed = String -> XmlRep
XLit String
"slashed"
    emitXml NoteheadValue
NoteheadValueBackSlashed = String -> XmlRep
XLit String
"back slashed"
    emitXml NoteheadValue
NoteheadValueNormal = String -> XmlRep
XLit String
"normal"
    emitXml NoteheadValue
NoteheadValueCluster = String -> XmlRep
XLit String
"cluster"
    emitXml NoteheadValue
NoteheadValueCircleDot = String -> XmlRep
XLit String
"circle dot"
    emitXml NoteheadValue
NoteheadValueLeftTriangle = String -> XmlRep
XLit String
"left triangle"
    emitXml NoteheadValue
NoteheadValueRectangle = String -> XmlRep
XLit String
"rectangle"
    emitXml NoteheadValue
NoteheadValueNone = String -> XmlRep
XLit String
"none"
    emitXml NoteheadValue
NoteheadValueDo = String -> XmlRep
XLit String
"do"
    emitXml NoteheadValue
NoteheadValueRe = String -> XmlRep
XLit String
"re"
    emitXml NoteheadValue
NoteheadValueMi = String -> XmlRep
XLit String
"mi"
    emitXml NoteheadValue
NoteheadValueFa = String -> XmlRep
XLit String
"fa"
    emitXml NoteheadValue
NoteheadValueFaUp = String -> XmlRep
XLit String
"fa up"
    emitXml NoteheadValue
NoteheadValueSo = String -> XmlRep
XLit String
"so"
    emitXml NoteheadValue
NoteheadValueLa = String -> XmlRep
XLit String
"la"
    emitXml NoteheadValue
NoteheadValueTi = String -> XmlRep
XLit String
"ti"
    emitXml NoteheadValue
NoteheadValueOther = String -> XmlRep
XLit String
"other"
parseNoteheadValue :: String -> P.XParse NoteheadValue
parseNoteheadValue :: String -> XParse NoteheadValue
parseNoteheadValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slash" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueSlash
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"triangle" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueTriangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diamond" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueDiamond
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"square" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueSquare
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cross" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueCross
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueX
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"circle-x" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueCircleX
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"inverted triangle" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueInvertedTriangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arrow down" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueArrowDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arrow up" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueArrowUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"circled" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueCircled
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slashed" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueSlashed
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"back slashed" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueBackSlashed
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueNormal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cluster" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueCluster
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"circle dot" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueCircleDot
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left triangle" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueLeftTriangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rectangle" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueRectangle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueNone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"do" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueDo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"re" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueRe
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mi" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueMi
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fa" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueFa
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"fa up" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueFaUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"so" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueSo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"la" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueLa
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ti" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueTi
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = NoteheadValue -> XParse NoteheadValue
forall (m :: * -> *) a. Monad m => a -> m a
return (NoteheadValue -> XParse NoteheadValue)
-> NoteheadValue -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ NoteheadValue
NoteheadValueOther
        | Bool
otherwise = String -> XParse NoteheadValue
forall a. String -> XParse a
P.xfail (String -> XParse NoteheadValue) -> String -> XParse NoteheadValue
forall a b. (a -> b) -> a -> b
$ String
"NoteheadValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @number-level@ /(simple)/
--
-- Slurs, tuplets, and many other features can be concurrent and overlapping within a single musical part. The number-level type distinguishes up to six concurrent objects of the same type. A reading program should be prepared to handle cases where the number-levels stop in an arbitrary order. Different numbers are needed when the features overlap in MusicXML document order. When a number-level value is optional, the value is 1 by default.
newtype NumberLevel = NumberLevel { NumberLevel -> PositiveInteger
numberLevel :: PositiveInteger }
    deriving (NumberLevel -> NumberLevel -> Bool
(NumberLevel -> NumberLevel -> Bool)
-> (NumberLevel -> NumberLevel -> Bool) -> Eq NumberLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberLevel -> NumberLevel -> Bool
$c/= :: NumberLevel -> NumberLevel -> Bool
== :: NumberLevel -> NumberLevel -> Bool
$c== :: NumberLevel -> NumberLevel -> Bool
Eq,Typeable,(forall x. NumberLevel -> Rep NumberLevel x)
-> (forall x. Rep NumberLevel x -> NumberLevel)
-> Generic NumberLevel
forall x. Rep NumberLevel x -> NumberLevel
forall x. NumberLevel -> Rep NumberLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberLevel x -> NumberLevel
$cfrom :: forall x. NumberLevel -> Rep NumberLevel x
Generic,Eq NumberLevel
Eq NumberLevel
-> (NumberLevel -> NumberLevel -> Ordering)
-> (NumberLevel -> NumberLevel -> Bool)
-> (NumberLevel -> NumberLevel -> Bool)
-> (NumberLevel -> NumberLevel -> Bool)
-> (NumberLevel -> NumberLevel -> Bool)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> Ord NumberLevel
NumberLevel -> NumberLevel -> Bool
NumberLevel -> NumberLevel -> Ordering
NumberLevel -> NumberLevel -> NumberLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumberLevel -> NumberLevel -> NumberLevel
$cmin :: NumberLevel -> NumberLevel -> NumberLevel
max :: NumberLevel -> NumberLevel -> NumberLevel
$cmax :: NumberLevel -> NumberLevel -> NumberLevel
>= :: NumberLevel -> NumberLevel -> Bool
$c>= :: NumberLevel -> NumberLevel -> Bool
> :: NumberLevel -> NumberLevel -> Bool
$c> :: NumberLevel -> NumberLevel -> Bool
<= :: NumberLevel -> NumberLevel -> Bool
$c<= :: NumberLevel -> NumberLevel -> Bool
< :: NumberLevel -> NumberLevel -> Bool
$c< :: NumberLevel -> NumberLevel -> Bool
compare :: NumberLevel -> NumberLevel -> Ordering
$ccompare :: NumberLevel -> NumberLevel -> Ordering
$cp1Ord :: Eq NumberLevel
Ord,NumberLevel
NumberLevel -> NumberLevel -> Bounded NumberLevel
forall a. a -> a -> Bounded a
maxBound :: NumberLevel
$cmaxBound :: NumberLevel
minBound :: NumberLevel
$cminBound :: NumberLevel
Bounded,Int -> NumberLevel
NumberLevel -> Int
NumberLevel -> [NumberLevel]
NumberLevel -> NumberLevel
NumberLevel -> NumberLevel -> [NumberLevel]
NumberLevel -> NumberLevel -> NumberLevel -> [NumberLevel]
(NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel)
-> (Int -> NumberLevel)
-> (NumberLevel -> Int)
-> (NumberLevel -> [NumberLevel])
-> (NumberLevel -> NumberLevel -> [NumberLevel])
-> (NumberLevel -> NumberLevel -> [NumberLevel])
-> (NumberLevel -> NumberLevel -> NumberLevel -> [NumberLevel])
-> Enum NumberLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumberLevel -> NumberLevel -> NumberLevel -> [NumberLevel]
$cenumFromThenTo :: NumberLevel -> NumberLevel -> NumberLevel -> [NumberLevel]
enumFromTo :: NumberLevel -> NumberLevel -> [NumberLevel]
$cenumFromTo :: NumberLevel -> NumberLevel -> [NumberLevel]
enumFromThen :: NumberLevel -> NumberLevel -> [NumberLevel]
$cenumFromThen :: NumberLevel -> NumberLevel -> [NumberLevel]
enumFrom :: NumberLevel -> [NumberLevel]
$cenumFrom :: NumberLevel -> [NumberLevel]
fromEnum :: NumberLevel -> Int
$cfromEnum :: NumberLevel -> Int
toEnum :: Int -> NumberLevel
$ctoEnum :: Int -> NumberLevel
pred :: NumberLevel -> NumberLevel
$cpred :: NumberLevel -> NumberLevel
succ :: NumberLevel -> NumberLevel
$csucc :: NumberLevel -> NumberLevel
Enum,Integer -> NumberLevel
NumberLevel -> NumberLevel
NumberLevel -> NumberLevel -> NumberLevel
(NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel)
-> (Integer -> NumberLevel)
-> Num NumberLevel
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumberLevel
$cfromInteger :: Integer -> NumberLevel
signum :: NumberLevel -> NumberLevel
$csignum :: NumberLevel -> NumberLevel
abs :: NumberLevel -> NumberLevel
$cabs :: NumberLevel -> NumberLevel
negate :: NumberLevel -> NumberLevel
$cnegate :: NumberLevel -> NumberLevel
* :: NumberLevel -> NumberLevel -> NumberLevel
$c* :: NumberLevel -> NumberLevel -> NumberLevel
- :: NumberLevel -> NumberLevel -> NumberLevel
$c- :: NumberLevel -> NumberLevel -> NumberLevel
+ :: NumberLevel -> NumberLevel -> NumberLevel
$c+ :: NumberLevel -> NumberLevel -> NumberLevel
Num,Num NumberLevel
Ord NumberLevel
Num NumberLevel
-> Ord NumberLevel -> (NumberLevel -> Rational) -> Real NumberLevel
NumberLevel -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NumberLevel -> Rational
$ctoRational :: NumberLevel -> Rational
$cp2Real :: Ord NumberLevel
$cp1Real :: Num NumberLevel
Real,Enum NumberLevel
Real NumberLevel
Real NumberLevel
-> Enum NumberLevel
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> NumberLevel)
-> (NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel))
-> (NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel))
-> (NumberLevel -> Integer)
-> Integral NumberLevel
NumberLevel -> Integer
NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel)
NumberLevel -> NumberLevel -> NumberLevel
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: NumberLevel -> Integer
$ctoInteger :: NumberLevel -> Integer
divMod :: NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel)
$cdivMod :: NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel)
quotRem :: NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel)
$cquotRem :: NumberLevel -> NumberLevel -> (NumberLevel, NumberLevel)
mod :: NumberLevel -> NumberLevel -> NumberLevel
$cmod :: NumberLevel -> NumberLevel -> NumberLevel
div :: NumberLevel -> NumberLevel -> NumberLevel
$cdiv :: NumberLevel -> NumberLevel -> NumberLevel
rem :: NumberLevel -> NumberLevel -> NumberLevel
$crem :: NumberLevel -> NumberLevel -> NumberLevel
quot :: NumberLevel -> NumberLevel -> NumberLevel
$cquot :: NumberLevel -> NumberLevel -> NumberLevel
$cp2Integral :: Enum NumberLevel
$cp1Integral :: Real NumberLevel
Integral)
instance Show NumberLevel where show :: NumberLevel -> String
show (NumberLevel PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read NumberLevel where readsPrec :: Int -> ReadS NumberLevel
readsPrec Int
i = ((PositiveInteger, String) -> (NumberLevel, String))
-> [(PositiveInteger, String)] -> [(NumberLevel, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> NumberLevel)
-> (PositiveInteger, String) -> (NumberLevel, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> NumberLevel
NumberLevel) ([(PositiveInteger, String)] -> [(NumberLevel, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS NumberLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NumberLevel where
    emitXml :: NumberLevel -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (NumberLevel -> PositiveInteger) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberLevel -> PositiveInteger
numberLevel
parseNumberLevel :: String -> P.XParse NumberLevel
parseNumberLevel :: String -> XParse NumberLevel
parseNumberLevel = String -> String -> XParse NumberLevel
forall a. Read a => String -> String -> XParse a
P.xread String
"NumberLevel"

-- | @number-of-lines@ /(simple)/
--
-- The number-of-lines type is used to specify the number of lines in text decoration attributes.
newtype NumberOfLines = NumberOfLines { NumberOfLines -> NonNegativeInteger
numberOfLines :: NonNegativeInteger }
    deriving (NumberOfLines -> NumberOfLines -> Bool
(NumberOfLines -> NumberOfLines -> Bool)
-> (NumberOfLines -> NumberOfLines -> Bool) -> Eq NumberOfLines
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberOfLines -> NumberOfLines -> Bool
$c/= :: NumberOfLines -> NumberOfLines -> Bool
== :: NumberOfLines -> NumberOfLines -> Bool
$c== :: NumberOfLines -> NumberOfLines -> Bool
Eq,Typeable,(forall x. NumberOfLines -> Rep NumberOfLines x)
-> (forall x. Rep NumberOfLines x -> NumberOfLines)
-> Generic NumberOfLines
forall x. Rep NumberOfLines x -> NumberOfLines
forall x. NumberOfLines -> Rep NumberOfLines x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberOfLines x -> NumberOfLines
$cfrom :: forall x. NumberOfLines -> Rep NumberOfLines x
Generic,Eq NumberOfLines
Eq NumberOfLines
-> (NumberOfLines -> NumberOfLines -> Ordering)
-> (NumberOfLines -> NumberOfLines -> Bool)
-> (NumberOfLines -> NumberOfLines -> Bool)
-> (NumberOfLines -> NumberOfLines -> Bool)
-> (NumberOfLines -> NumberOfLines -> Bool)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> Ord NumberOfLines
NumberOfLines -> NumberOfLines -> Bool
NumberOfLines -> NumberOfLines -> Ordering
NumberOfLines -> NumberOfLines -> NumberOfLines
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cmin :: NumberOfLines -> NumberOfLines -> NumberOfLines
max :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cmax :: NumberOfLines -> NumberOfLines -> NumberOfLines
>= :: NumberOfLines -> NumberOfLines -> Bool
$c>= :: NumberOfLines -> NumberOfLines -> Bool
> :: NumberOfLines -> NumberOfLines -> Bool
$c> :: NumberOfLines -> NumberOfLines -> Bool
<= :: NumberOfLines -> NumberOfLines -> Bool
$c<= :: NumberOfLines -> NumberOfLines -> Bool
< :: NumberOfLines -> NumberOfLines -> Bool
$c< :: NumberOfLines -> NumberOfLines -> Bool
compare :: NumberOfLines -> NumberOfLines -> Ordering
$ccompare :: NumberOfLines -> NumberOfLines -> Ordering
$cp1Ord :: Eq NumberOfLines
Ord,NumberOfLines
NumberOfLines -> NumberOfLines -> Bounded NumberOfLines
forall a. a -> a -> Bounded a
maxBound :: NumberOfLines
$cmaxBound :: NumberOfLines
minBound :: NumberOfLines
$cminBound :: NumberOfLines
Bounded,Int -> NumberOfLines
NumberOfLines -> Int
NumberOfLines -> [NumberOfLines]
NumberOfLines -> NumberOfLines
NumberOfLines -> NumberOfLines -> [NumberOfLines]
NumberOfLines -> NumberOfLines -> NumberOfLines -> [NumberOfLines]
(NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines)
-> (Int -> NumberOfLines)
-> (NumberOfLines -> Int)
-> (NumberOfLines -> [NumberOfLines])
-> (NumberOfLines -> NumberOfLines -> [NumberOfLines])
-> (NumberOfLines -> NumberOfLines -> [NumberOfLines])
-> (NumberOfLines
    -> NumberOfLines -> NumberOfLines -> [NumberOfLines])
-> Enum NumberOfLines
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NumberOfLines -> NumberOfLines -> NumberOfLines -> [NumberOfLines]
$cenumFromThenTo :: NumberOfLines -> NumberOfLines -> NumberOfLines -> [NumberOfLines]
enumFromTo :: NumberOfLines -> NumberOfLines -> [NumberOfLines]
$cenumFromTo :: NumberOfLines -> NumberOfLines -> [NumberOfLines]
enumFromThen :: NumberOfLines -> NumberOfLines -> [NumberOfLines]
$cenumFromThen :: NumberOfLines -> NumberOfLines -> [NumberOfLines]
enumFrom :: NumberOfLines -> [NumberOfLines]
$cenumFrom :: NumberOfLines -> [NumberOfLines]
fromEnum :: NumberOfLines -> Int
$cfromEnum :: NumberOfLines -> Int
toEnum :: Int -> NumberOfLines
$ctoEnum :: Int -> NumberOfLines
pred :: NumberOfLines -> NumberOfLines
$cpred :: NumberOfLines -> NumberOfLines
succ :: NumberOfLines -> NumberOfLines
$csucc :: NumberOfLines -> NumberOfLines
Enum,Integer -> NumberOfLines
NumberOfLines -> NumberOfLines
NumberOfLines -> NumberOfLines -> NumberOfLines
(NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines)
-> (Integer -> NumberOfLines)
-> Num NumberOfLines
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> NumberOfLines
$cfromInteger :: Integer -> NumberOfLines
signum :: NumberOfLines -> NumberOfLines
$csignum :: NumberOfLines -> NumberOfLines
abs :: NumberOfLines -> NumberOfLines
$cabs :: NumberOfLines -> NumberOfLines
negate :: NumberOfLines -> NumberOfLines
$cnegate :: NumberOfLines -> NumberOfLines
* :: NumberOfLines -> NumberOfLines -> NumberOfLines
$c* :: NumberOfLines -> NumberOfLines -> NumberOfLines
- :: NumberOfLines -> NumberOfLines -> NumberOfLines
$c- :: NumberOfLines -> NumberOfLines -> NumberOfLines
+ :: NumberOfLines -> NumberOfLines -> NumberOfLines
$c+ :: NumberOfLines -> NumberOfLines -> NumberOfLines
Num,Num NumberOfLines
Ord NumberOfLines
Num NumberOfLines
-> Ord NumberOfLines
-> (NumberOfLines -> Rational)
-> Real NumberOfLines
NumberOfLines -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: NumberOfLines -> Rational
$ctoRational :: NumberOfLines -> Rational
$cp2Real :: Ord NumberOfLines
$cp1Real :: Num NumberOfLines
Real,Enum NumberOfLines
Real NumberOfLines
Real NumberOfLines
-> Enum NumberOfLines
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines -> NumberOfLines -> NumberOfLines)
-> (NumberOfLines
    -> NumberOfLines -> (NumberOfLines, NumberOfLines))
-> (NumberOfLines
    -> NumberOfLines -> (NumberOfLines, NumberOfLines))
-> (NumberOfLines -> Integer)
-> Integral NumberOfLines
NumberOfLines -> Integer
NumberOfLines -> NumberOfLines -> (NumberOfLines, NumberOfLines)
NumberOfLines -> NumberOfLines -> NumberOfLines
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: NumberOfLines -> Integer
$ctoInteger :: NumberOfLines -> Integer
divMod :: NumberOfLines -> NumberOfLines -> (NumberOfLines, NumberOfLines)
$cdivMod :: NumberOfLines -> NumberOfLines -> (NumberOfLines, NumberOfLines)
quotRem :: NumberOfLines -> NumberOfLines -> (NumberOfLines, NumberOfLines)
$cquotRem :: NumberOfLines -> NumberOfLines -> (NumberOfLines, NumberOfLines)
mod :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cmod :: NumberOfLines -> NumberOfLines -> NumberOfLines
div :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cdiv :: NumberOfLines -> NumberOfLines -> NumberOfLines
rem :: NumberOfLines -> NumberOfLines -> NumberOfLines
$crem :: NumberOfLines -> NumberOfLines -> NumberOfLines
quot :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cquot :: NumberOfLines -> NumberOfLines -> NumberOfLines
$cp2Integral :: Enum NumberOfLines
$cp1Integral :: Real NumberOfLines
Integral)
instance Show NumberOfLines where show :: NumberOfLines -> String
show (NumberOfLines NonNegativeInteger
a) = NonNegativeInteger -> String
forall a. Show a => a -> String
show NonNegativeInteger
a
instance Read NumberOfLines where readsPrec :: Int -> ReadS NumberOfLines
readsPrec Int
i = ((NonNegativeInteger, String) -> (NumberOfLines, String))
-> [(NonNegativeInteger, String)] -> [(NumberOfLines, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NonNegativeInteger -> NumberOfLines)
-> (NonNegativeInteger, String) -> (NumberOfLines, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NonNegativeInteger -> NumberOfLines
NumberOfLines) ([(NonNegativeInteger, String)] -> [(NumberOfLines, String)])
-> ReadS NonNegativeInteger -> ReadS NumberOfLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS NonNegativeInteger
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml NumberOfLines where
    emitXml :: NumberOfLines -> XmlRep
emitXml = NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NonNegativeInteger -> XmlRep)
-> (NumberOfLines -> NonNegativeInteger) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberOfLines -> NonNegativeInteger
numberOfLines
parseNumberOfLines :: String -> P.XParse NumberOfLines
parseNumberOfLines :: String -> XParse NumberOfLines
parseNumberOfLines = String -> String -> XParse NumberOfLines
forall a. Read a => String -> String -> XParse a
P.xread String
"NumberOfLines"

-- | @number-or-normal@ /(simple)/
--
-- The number-or-normal values can be either a decimal number or the string "normal". This is used by the line-height and letter-spacing attributes.
data NumberOrNormal = 
      NumberOrNormalDecimal {
          NumberOrNormal -> Decimal
numberOrNormal1 :: Decimal
       }
    | NumberOrNormalNumberOrNormal {
          NumberOrNormal -> SumNumberOrNormal
numberOrNormal2 :: SumNumberOrNormal
       }
    deriving (NumberOrNormal -> NumberOrNormal -> Bool
(NumberOrNormal -> NumberOrNormal -> Bool)
-> (NumberOrNormal -> NumberOrNormal -> Bool) -> Eq NumberOrNormal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberOrNormal -> NumberOrNormal -> Bool
$c/= :: NumberOrNormal -> NumberOrNormal -> Bool
== :: NumberOrNormal -> NumberOrNormal -> Bool
$c== :: NumberOrNormal -> NumberOrNormal -> Bool
Eq,Typeable,(forall x. NumberOrNormal -> Rep NumberOrNormal x)
-> (forall x. Rep NumberOrNormal x -> NumberOrNormal)
-> Generic NumberOrNormal
forall x. Rep NumberOrNormal x -> NumberOrNormal
forall x. NumberOrNormal -> Rep NumberOrNormal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberOrNormal x -> NumberOrNormal
$cfrom :: forall x. NumberOrNormal -> Rep NumberOrNormal x
Generic,Int -> NumberOrNormal -> ShowS
[NumberOrNormal] -> ShowS
NumberOrNormal -> String
(Int -> NumberOrNormal -> ShowS)
-> (NumberOrNormal -> String)
-> ([NumberOrNormal] -> ShowS)
-> Show NumberOrNormal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberOrNormal] -> ShowS
$cshowList :: [NumberOrNormal] -> ShowS
show :: NumberOrNormal -> String
$cshow :: NumberOrNormal -> String
showsPrec :: Int -> NumberOrNormal -> ShowS
$cshowsPrec :: Int -> NumberOrNormal -> ShowS
Show)
instance EmitXml NumberOrNormal where
    emitXml :: NumberOrNormal -> XmlRep
emitXml (NumberOrNormalDecimal Decimal
a) = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Decimal
a
    emitXml (NumberOrNormalNumberOrNormal SumNumberOrNormal
a) = SumNumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SumNumberOrNormal
a
parseNumberOrNormal :: String -> P.XParse NumberOrNormal
parseNumberOrNormal :: String -> XParse NumberOrNormal
parseNumberOrNormal String
s = 
      Decimal -> NumberOrNormal
NumberOrNormalDecimal
        (Decimal -> NumberOrNormal)
-> XParse Decimal -> XParse NumberOrNormal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> XParse Decimal
forall a. Read a => String -> String -> XParse a
P.xread String
"Decimal") String
s
      XParse NumberOrNormal
-> XParse NumberOrNormal -> XParse NumberOrNormal
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SumNumberOrNormal -> NumberOrNormal
NumberOrNormalNumberOrNormal
        (SumNumberOrNormal -> NumberOrNormal)
-> XParse SumNumberOrNormal -> XParse NumberOrNormal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse SumNumberOrNormal
parseSumNumberOrNormal String
s


-- | @octave@ /(simple)/
--
-- Octaves are represented by the numbers 0 to 9, where 4 indicates the octave started by middle C.
newtype Octave = Octave { Octave -> Int
octave :: Int }
    deriving (Octave -> Octave -> Bool
(Octave -> Octave -> Bool)
-> (Octave -> Octave -> Bool) -> Eq Octave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Octave -> Octave -> Bool
$c/= :: Octave -> Octave -> Bool
== :: Octave -> Octave -> Bool
$c== :: Octave -> Octave -> Bool
Eq,Typeable,(forall x. Octave -> Rep Octave x)
-> (forall x. Rep Octave x -> Octave) -> Generic Octave
forall x. Rep Octave x -> Octave
forall x. Octave -> Rep Octave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Octave x -> Octave
$cfrom :: forall x. Octave -> Rep Octave x
Generic,Eq Octave
Eq Octave
-> (Octave -> Octave -> Ordering)
-> (Octave -> Octave -> Bool)
-> (Octave -> Octave -> Bool)
-> (Octave -> Octave -> Bool)
-> (Octave -> Octave -> Bool)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> Ord Octave
Octave -> Octave -> Bool
Octave -> Octave -> Ordering
Octave -> Octave -> Octave
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Octave -> Octave -> Octave
$cmin :: Octave -> Octave -> Octave
max :: Octave -> Octave -> Octave
$cmax :: Octave -> Octave -> Octave
>= :: Octave -> Octave -> Bool
$c>= :: Octave -> Octave -> Bool
> :: Octave -> Octave -> Bool
$c> :: Octave -> Octave -> Bool
<= :: Octave -> Octave -> Bool
$c<= :: Octave -> Octave -> Bool
< :: Octave -> Octave -> Bool
$c< :: Octave -> Octave -> Bool
compare :: Octave -> Octave -> Ordering
$ccompare :: Octave -> Octave -> Ordering
$cp1Ord :: Eq Octave
Ord,Octave
Octave -> Octave -> Bounded Octave
forall a. a -> a -> Bounded a
maxBound :: Octave
$cmaxBound :: Octave
minBound :: Octave
$cminBound :: Octave
Bounded,Int -> Octave
Octave -> Int
Octave -> [Octave]
Octave -> Octave
Octave -> Octave -> [Octave]
Octave -> Octave -> Octave -> [Octave]
(Octave -> Octave)
-> (Octave -> Octave)
-> (Int -> Octave)
-> (Octave -> Int)
-> (Octave -> [Octave])
-> (Octave -> Octave -> [Octave])
-> (Octave -> Octave -> [Octave])
-> (Octave -> Octave -> Octave -> [Octave])
-> Enum Octave
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Octave -> Octave -> Octave -> [Octave]
$cenumFromThenTo :: Octave -> Octave -> Octave -> [Octave]
enumFromTo :: Octave -> Octave -> [Octave]
$cenumFromTo :: Octave -> Octave -> [Octave]
enumFromThen :: Octave -> Octave -> [Octave]
$cenumFromThen :: Octave -> Octave -> [Octave]
enumFrom :: Octave -> [Octave]
$cenumFrom :: Octave -> [Octave]
fromEnum :: Octave -> Int
$cfromEnum :: Octave -> Int
toEnum :: Int -> Octave
$ctoEnum :: Int -> Octave
pred :: Octave -> Octave
$cpred :: Octave -> Octave
succ :: Octave -> Octave
$csucc :: Octave -> Octave
Enum,Integer -> Octave
Octave -> Octave
Octave -> Octave -> Octave
(Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave)
-> (Octave -> Octave)
-> (Octave -> Octave)
-> (Integer -> Octave)
-> Num Octave
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Octave
$cfromInteger :: Integer -> Octave
signum :: Octave -> Octave
$csignum :: Octave -> Octave
abs :: Octave -> Octave
$cabs :: Octave -> Octave
negate :: Octave -> Octave
$cnegate :: Octave -> Octave
* :: Octave -> Octave -> Octave
$c* :: Octave -> Octave -> Octave
- :: Octave -> Octave -> Octave
$c- :: Octave -> Octave -> Octave
+ :: Octave -> Octave -> Octave
$c+ :: Octave -> Octave -> Octave
Num,Num Octave
Ord Octave
Num Octave -> Ord Octave -> (Octave -> Rational) -> Real Octave
Octave -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Octave -> Rational
$ctoRational :: Octave -> Rational
$cp2Real :: Ord Octave
$cp1Real :: Num Octave
Real,Enum Octave
Real Octave
Real Octave
-> Enum Octave
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> Octave)
-> (Octave -> Octave -> (Octave, Octave))
-> (Octave -> Octave -> (Octave, Octave))
-> (Octave -> Integer)
-> Integral Octave
Octave -> Integer
Octave -> Octave -> (Octave, Octave)
Octave -> Octave -> Octave
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Octave -> Integer
$ctoInteger :: Octave -> Integer
divMod :: Octave -> Octave -> (Octave, Octave)
$cdivMod :: Octave -> Octave -> (Octave, Octave)
quotRem :: Octave -> Octave -> (Octave, Octave)
$cquotRem :: Octave -> Octave -> (Octave, Octave)
mod :: Octave -> Octave -> Octave
$cmod :: Octave -> Octave -> Octave
div :: Octave -> Octave -> Octave
$cdiv :: Octave -> Octave -> Octave
rem :: Octave -> Octave -> Octave
$crem :: Octave -> Octave -> Octave
quot :: Octave -> Octave -> Octave
$cquot :: Octave -> Octave -> Octave
$cp2Integral :: Enum Octave
$cp1Integral :: Real Octave
Integral)
instance Show Octave where show :: Octave -> String
show (Octave Int
a) = Int -> String
forall a. Show a => a -> String
show Int
a
instance Read Octave where readsPrec :: Int -> ReadS Octave
readsPrec Int
i = ((Int, String) -> (Octave, String))
-> [(Int, String)] -> [(Octave, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Octave) -> (Int, String) -> (Octave, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Int -> Octave
Octave) ([(Int, String)] -> [(Octave, String)])
-> (String -> [(Int, String)]) -> ReadS Octave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Octave where
    emitXml :: Octave -> XmlRep
emitXml = Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Int -> XmlRep) -> (Octave -> Int) -> Octave -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Octave -> Int
octave
parseOctave :: String -> P.XParse Octave
parseOctave :: String -> XParse Octave
parseOctave = String -> String -> XParse Octave
forall a. Read a => String -> String -> XParse a
P.xread String
"Octave"

-- | @on-off@ /(simple)/
--
-- The on-off type is used for notation elements such as string mutes.
data OnOff = 
      OnOffOn -- ^ /on/
    | OnOffOff -- ^ /off/
    deriving (OnOff -> OnOff -> Bool
(OnOff -> OnOff -> Bool) -> (OnOff -> OnOff -> Bool) -> Eq OnOff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnOff -> OnOff -> Bool
$c/= :: OnOff -> OnOff -> Bool
== :: OnOff -> OnOff -> Bool
$c== :: OnOff -> OnOff -> Bool
Eq,Typeable,(forall x. OnOff -> Rep OnOff x)
-> (forall x. Rep OnOff x -> OnOff) -> Generic OnOff
forall x. Rep OnOff x -> OnOff
forall x. OnOff -> Rep OnOff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OnOff x -> OnOff
$cfrom :: forall x. OnOff -> Rep OnOff x
Generic,Int -> OnOff -> ShowS
[OnOff] -> ShowS
OnOff -> String
(Int -> OnOff -> ShowS)
-> (OnOff -> String) -> ([OnOff] -> ShowS) -> Show OnOff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnOff] -> ShowS
$cshowList :: [OnOff] -> ShowS
show :: OnOff -> String
$cshow :: OnOff -> String
showsPrec :: Int -> OnOff -> ShowS
$cshowsPrec :: Int -> OnOff -> ShowS
Show,Eq OnOff
Eq OnOff
-> (OnOff -> OnOff -> Ordering)
-> (OnOff -> OnOff -> Bool)
-> (OnOff -> OnOff -> Bool)
-> (OnOff -> OnOff -> Bool)
-> (OnOff -> OnOff -> Bool)
-> (OnOff -> OnOff -> OnOff)
-> (OnOff -> OnOff -> OnOff)
-> Ord OnOff
OnOff -> OnOff -> Bool
OnOff -> OnOff -> Ordering
OnOff -> OnOff -> OnOff
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OnOff -> OnOff -> OnOff
$cmin :: OnOff -> OnOff -> OnOff
max :: OnOff -> OnOff -> OnOff
$cmax :: OnOff -> OnOff -> OnOff
>= :: OnOff -> OnOff -> Bool
$c>= :: OnOff -> OnOff -> Bool
> :: OnOff -> OnOff -> Bool
$c> :: OnOff -> OnOff -> Bool
<= :: OnOff -> OnOff -> Bool
$c<= :: OnOff -> OnOff -> Bool
< :: OnOff -> OnOff -> Bool
$c< :: OnOff -> OnOff -> Bool
compare :: OnOff -> OnOff -> Ordering
$ccompare :: OnOff -> OnOff -> Ordering
$cp1Ord :: Eq OnOff
Ord,Int -> OnOff
OnOff -> Int
OnOff -> [OnOff]
OnOff -> OnOff
OnOff -> OnOff -> [OnOff]
OnOff -> OnOff -> OnOff -> [OnOff]
(OnOff -> OnOff)
-> (OnOff -> OnOff)
-> (Int -> OnOff)
-> (OnOff -> Int)
-> (OnOff -> [OnOff])
-> (OnOff -> OnOff -> [OnOff])
-> (OnOff -> OnOff -> [OnOff])
-> (OnOff -> OnOff -> OnOff -> [OnOff])
-> Enum OnOff
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OnOff -> OnOff -> OnOff -> [OnOff]
$cenumFromThenTo :: OnOff -> OnOff -> OnOff -> [OnOff]
enumFromTo :: OnOff -> OnOff -> [OnOff]
$cenumFromTo :: OnOff -> OnOff -> [OnOff]
enumFromThen :: OnOff -> OnOff -> [OnOff]
$cenumFromThen :: OnOff -> OnOff -> [OnOff]
enumFrom :: OnOff -> [OnOff]
$cenumFrom :: OnOff -> [OnOff]
fromEnum :: OnOff -> Int
$cfromEnum :: OnOff -> Int
toEnum :: Int -> OnOff
$ctoEnum :: Int -> OnOff
pred :: OnOff -> OnOff
$cpred :: OnOff -> OnOff
succ :: OnOff -> OnOff
$csucc :: OnOff -> OnOff
Enum,OnOff
OnOff -> OnOff -> Bounded OnOff
forall a. a -> a -> Bounded a
maxBound :: OnOff
$cmaxBound :: OnOff
minBound :: OnOff
$cminBound :: OnOff
Bounded)
instance EmitXml OnOff where
    emitXml :: OnOff -> XmlRep
emitXml OnOff
OnOffOn = String -> XmlRep
XLit String
"on"
    emitXml OnOff
OnOffOff = String -> XmlRep
XLit String
"off"
parseOnOff :: String -> P.XParse OnOff
parseOnOff :: String -> XParse OnOff
parseOnOff String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"on" = OnOff -> XParse OnOff
forall (m :: * -> *) a. Monad m => a -> m a
return (OnOff -> XParse OnOff) -> OnOff -> XParse OnOff
forall a b. (a -> b) -> a -> b
$ OnOff
OnOffOn
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"off" = OnOff -> XParse OnOff
forall (m :: * -> *) a. Monad m => a -> m a
return (OnOff -> XParse OnOff) -> OnOff -> XParse OnOff
forall a b. (a -> b) -> a -> b
$ OnOff
OnOffOff
        | Bool
otherwise = String -> XParse OnOff
forall a. String -> XParse a
P.xfail (String -> XParse OnOff) -> String -> XParse OnOff
forall a b. (a -> b) -> a -> b
$ String
"OnOff: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @over-under@ /(simple)/
--
-- The over-under type is used to indicate whether the tips of curved lines such as slurs and ties are overhand (tips down) or underhand (tips up).
data OverUnder = 
      OverUnderOver -- ^ /over/
    | OverUnderUnder -- ^ /under/
    deriving (OverUnder -> OverUnder -> Bool
(OverUnder -> OverUnder -> Bool)
-> (OverUnder -> OverUnder -> Bool) -> Eq OverUnder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverUnder -> OverUnder -> Bool
$c/= :: OverUnder -> OverUnder -> Bool
== :: OverUnder -> OverUnder -> Bool
$c== :: OverUnder -> OverUnder -> Bool
Eq,Typeable,(forall x. OverUnder -> Rep OverUnder x)
-> (forall x. Rep OverUnder x -> OverUnder) -> Generic OverUnder
forall x. Rep OverUnder x -> OverUnder
forall x. OverUnder -> Rep OverUnder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OverUnder x -> OverUnder
$cfrom :: forall x. OverUnder -> Rep OverUnder x
Generic,Int -> OverUnder -> ShowS
[OverUnder] -> ShowS
OverUnder -> String
(Int -> OverUnder -> ShowS)
-> (OverUnder -> String)
-> ([OverUnder] -> ShowS)
-> Show OverUnder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverUnder] -> ShowS
$cshowList :: [OverUnder] -> ShowS
show :: OverUnder -> String
$cshow :: OverUnder -> String
showsPrec :: Int -> OverUnder -> ShowS
$cshowsPrec :: Int -> OverUnder -> ShowS
Show,Eq OverUnder
Eq OverUnder
-> (OverUnder -> OverUnder -> Ordering)
-> (OverUnder -> OverUnder -> Bool)
-> (OverUnder -> OverUnder -> Bool)
-> (OverUnder -> OverUnder -> Bool)
-> (OverUnder -> OverUnder -> Bool)
-> (OverUnder -> OverUnder -> OverUnder)
-> (OverUnder -> OverUnder -> OverUnder)
-> Ord OverUnder
OverUnder -> OverUnder -> Bool
OverUnder -> OverUnder -> Ordering
OverUnder -> OverUnder -> OverUnder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OverUnder -> OverUnder -> OverUnder
$cmin :: OverUnder -> OverUnder -> OverUnder
max :: OverUnder -> OverUnder -> OverUnder
$cmax :: OverUnder -> OverUnder -> OverUnder
>= :: OverUnder -> OverUnder -> Bool
$c>= :: OverUnder -> OverUnder -> Bool
> :: OverUnder -> OverUnder -> Bool
$c> :: OverUnder -> OverUnder -> Bool
<= :: OverUnder -> OverUnder -> Bool
$c<= :: OverUnder -> OverUnder -> Bool
< :: OverUnder -> OverUnder -> Bool
$c< :: OverUnder -> OverUnder -> Bool
compare :: OverUnder -> OverUnder -> Ordering
$ccompare :: OverUnder -> OverUnder -> Ordering
$cp1Ord :: Eq OverUnder
Ord,Int -> OverUnder
OverUnder -> Int
OverUnder -> [OverUnder]
OverUnder -> OverUnder
OverUnder -> OverUnder -> [OverUnder]
OverUnder -> OverUnder -> OverUnder -> [OverUnder]
(OverUnder -> OverUnder)
-> (OverUnder -> OverUnder)
-> (Int -> OverUnder)
-> (OverUnder -> Int)
-> (OverUnder -> [OverUnder])
-> (OverUnder -> OverUnder -> [OverUnder])
-> (OverUnder -> OverUnder -> [OverUnder])
-> (OverUnder -> OverUnder -> OverUnder -> [OverUnder])
-> Enum OverUnder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OverUnder -> OverUnder -> OverUnder -> [OverUnder]
$cenumFromThenTo :: OverUnder -> OverUnder -> OverUnder -> [OverUnder]
enumFromTo :: OverUnder -> OverUnder -> [OverUnder]
$cenumFromTo :: OverUnder -> OverUnder -> [OverUnder]
enumFromThen :: OverUnder -> OverUnder -> [OverUnder]
$cenumFromThen :: OverUnder -> OverUnder -> [OverUnder]
enumFrom :: OverUnder -> [OverUnder]
$cenumFrom :: OverUnder -> [OverUnder]
fromEnum :: OverUnder -> Int
$cfromEnum :: OverUnder -> Int
toEnum :: Int -> OverUnder
$ctoEnum :: Int -> OverUnder
pred :: OverUnder -> OverUnder
$cpred :: OverUnder -> OverUnder
succ :: OverUnder -> OverUnder
$csucc :: OverUnder -> OverUnder
Enum,OverUnder
OverUnder -> OverUnder -> Bounded OverUnder
forall a. a -> a -> Bounded a
maxBound :: OverUnder
$cmaxBound :: OverUnder
minBound :: OverUnder
$cminBound :: OverUnder
Bounded)
instance EmitXml OverUnder where
    emitXml :: OverUnder -> XmlRep
emitXml OverUnder
OverUnderOver = String -> XmlRep
XLit String
"over"
    emitXml OverUnder
OverUnderUnder = String -> XmlRep
XLit String
"under"
parseOverUnder :: String -> P.XParse OverUnder
parseOverUnder :: String -> XParse OverUnder
parseOverUnder String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"over" = OverUnder -> XParse OverUnder
forall (m :: * -> *) a. Monad m => a -> m a
return (OverUnder -> XParse OverUnder) -> OverUnder -> XParse OverUnder
forall a b. (a -> b) -> a -> b
$ OverUnder
OverUnderOver
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"under" = OverUnder -> XParse OverUnder
forall (m :: * -> *) a. Monad m => a -> m a
return (OverUnder -> XParse OverUnder) -> OverUnder -> XParse OverUnder
forall a b. (a -> b) -> a -> b
$ OverUnder
OverUnderUnder
        | Bool
otherwise = String -> XParse OverUnder
forall a. String -> XParse a
P.xfail (String -> XParse OverUnder) -> String -> XParse OverUnder
forall a b. (a -> b) -> a -> b
$ String
"OverUnder: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @pedal-type@ /(simple)/
--
-- The pedal-type simple type is used to distinguish types of pedal directions. The start value indicates the start of a damper pedal, while the sostenuto value indicates the start of a sostenuto pedal. The change, continue, and stop values can be used with either the damper or sostenuto pedal. The soft pedal is not included here because there is no special symbol or graphic used for it beyond what can be specified with words and bracket elements.
data PedalType = 
      PedalTypeStart -- ^ /start/
    | PedalTypeStop -- ^ /stop/
    | PedalTypeSostenuto -- ^ /sostenuto/
    | PedalTypeChange -- ^ /change/
    | PedalTypeContinue -- ^ /continue/
    deriving (PedalType -> PedalType -> Bool
(PedalType -> PedalType -> Bool)
-> (PedalType -> PedalType -> Bool) -> Eq PedalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PedalType -> PedalType -> Bool
$c/= :: PedalType -> PedalType -> Bool
== :: PedalType -> PedalType -> Bool
$c== :: PedalType -> PedalType -> Bool
Eq,Typeable,(forall x. PedalType -> Rep PedalType x)
-> (forall x. Rep PedalType x -> PedalType) -> Generic PedalType
forall x. Rep PedalType x -> PedalType
forall x. PedalType -> Rep PedalType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PedalType x -> PedalType
$cfrom :: forall x. PedalType -> Rep PedalType x
Generic,Int -> PedalType -> ShowS
[PedalType] -> ShowS
PedalType -> String
(Int -> PedalType -> ShowS)
-> (PedalType -> String)
-> ([PedalType] -> ShowS)
-> Show PedalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PedalType] -> ShowS
$cshowList :: [PedalType] -> ShowS
show :: PedalType -> String
$cshow :: PedalType -> String
showsPrec :: Int -> PedalType -> ShowS
$cshowsPrec :: Int -> PedalType -> ShowS
Show,Eq PedalType
Eq PedalType
-> (PedalType -> PedalType -> Ordering)
-> (PedalType -> PedalType -> Bool)
-> (PedalType -> PedalType -> Bool)
-> (PedalType -> PedalType -> Bool)
-> (PedalType -> PedalType -> Bool)
-> (PedalType -> PedalType -> PedalType)
-> (PedalType -> PedalType -> PedalType)
-> Ord PedalType
PedalType -> PedalType -> Bool
PedalType -> PedalType -> Ordering
PedalType -> PedalType -> PedalType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PedalType -> PedalType -> PedalType
$cmin :: PedalType -> PedalType -> PedalType
max :: PedalType -> PedalType -> PedalType
$cmax :: PedalType -> PedalType -> PedalType
>= :: PedalType -> PedalType -> Bool
$c>= :: PedalType -> PedalType -> Bool
> :: PedalType -> PedalType -> Bool
$c> :: PedalType -> PedalType -> Bool
<= :: PedalType -> PedalType -> Bool
$c<= :: PedalType -> PedalType -> Bool
< :: PedalType -> PedalType -> Bool
$c< :: PedalType -> PedalType -> Bool
compare :: PedalType -> PedalType -> Ordering
$ccompare :: PedalType -> PedalType -> Ordering
$cp1Ord :: Eq PedalType
Ord,Int -> PedalType
PedalType -> Int
PedalType -> [PedalType]
PedalType -> PedalType
PedalType -> PedalType -> [PedalType]
PedalType -> PedalType -> PedalType -> [PedalType]
(PedalType -> PedalType)
-> (PedalType -> PedalType)
-> (Int -> PedalType)
-> (PedalType -> Int)
-> (PedalType -> [PedalType])
-> (PedalType -> PedalType -> [PedalType])
-> (PedalType -> PedalType -> [PedalType])
-> (PedalType -> PedalType -> PedalType -> [PedalType])
-> Enum PedalType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PedalType -> PedalType -> PedalType -> [PedalType]
$cenumFromThenTo :: PedalType -> PedalType -> PedalType -> [PedalType]
enumFromTo :: PedalType -> PedalType -> [PedalType]
$cenumFromTo :: PedalType -> PedalType -> [PedalType]
enumFromThen :: PedalType -> PedalType -> [PedalType]
$cenumFromThen :: PedalType -> PedalType -> [PedalType]
enumFrom :: PedalType -> [PedalType]
$cenumFrom :: PedalType -> [PedalType]
fromEnum :: PedalType -> Int
$cfromEnum :: PedalType -> Int
toEnum :: Int -> PedalType
$ctoEnum :: Int -> PedalType
pred :: PedalType -> PedalType
$cpred :: PedalType -> PedalType
succ :: PedalType -> PedalType
$csucc :: PedalType -> PedalType
Enum,PedalType
PedalType -> PedalType -> Bounded PedalType
forall a. a -> a -> Bounded a
maxBound :: PedalType
$cmaxBound :: PedalType
minBound :: PedalType
$cminBound :: PedalType
Bounded)
instance EmitXml PedalType where
    emitXml :: PedalType -> XmlRep
emitXml PedalType
PedalTypeStart = String -> XmlRep
XLit String
"start"
    emitXml PedalType
PedalTypeStop = String -> XmlRep
XLit String
"stop"
    emitXml PedalType
PedalTypeSostenuto = String -> XmlRep
XLit String
"sostenuto"
    emitXml PedalType
PedalTypeChange = String -> XmlRep
XLit String
"change"
    emitXml PedalType
PedalTypeContinue = String -> XmlRep
XLit String
"continue"
parsePedalType :: String -> P.XParse PedalType
parsePedalType :: String -> XParse PedalType
parsePedalType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = PedalType -> XParse PedalType
forall (m :: * -> *) a. Monad m => a -> m a
return (PedalType -> XParse PedalType) -> PedalType -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ PedalType
PedalTypeStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = PedalType -> XParse PedalType
forall (m :: * -> *) a. Monad m => a -> m a
return (PedalType -> XParse PedalType) -> PedalType -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ PedalType
PedalTypeStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sostenuto" = PedalType -> XParse PedalType
forall (m :: * -> *) a. Monad m => a -> m a
return (PedalType -> XParse PedalType) -> PedalType -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ PedalType
PedalTypeSostenuto
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"change" = PedalType -> XParse PedalType
forall (m :: * -> *) a. Monad m => a -> m a
return (PedalType -> XParse PedalType) -> PedalType -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ PedalType
PedalTypeChange
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = PedalType -> XParse PedalType
forall (m :: * -> *) a. Monad m => a -> m a
return (PedalType -> XParse PedalType) -> PedalType -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ PedalType
PedalTypeContinue
        | Bool
otherwise = String -> XParse PedalType
forall a. String -> XParse a
P.xfail (String -> XParse PedalType) -> String -> XParse PedalType
forall a b. (a -> b) -> a -> b
$ String
"PedalType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @percent@ /(simple)/
--
-- The percent type specifies a percentage from 0 to 100.
newtype Percent = Percent { Percent -> Decimal
percent :: Decimal }
    deriving (Percent -> Percent -> Bool
(Percent -> Percent -> Bool)
-> (Percent -> Percent -> Bool) -> Eq Percent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Percent -> Percent -> Bool
$c/= :: Percent -> Percent -> Bool
== :: Percent -> Percent -> Bool
$c== :: Percent -> Percent -> Bool
Eq,Typeable,(forall x. Percent -> Rep Percent x)
-> (forall x. Rep Percent x -> Percent) -> Generic Percent
forall x. Rep Percent x -> Percent
forall x. Percent -> Rep Percent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Percent x -> Percent
$cfrom :: forall x. Percent -> Rep Percent x
Generic,Eq Percent
Eq Percent
-> (Percent -> Percent -> Ordering)
-> (Percent -> Percent -> Bool)
-> (Percent -> Percent -> Bool)
-> (Percent -> Percent -> Bool)
-> (Percent -> Percent -> Bool)
-> (Percent -> Percent -> Percent)
-> (Percent -> Percent -> Percent)
-> Ord Percent
Percent -> Percent -> Bool
Percent -> Percent -> Ordering
Percent -> Percent -> Percent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Percent -> Percent -> Percent
$cmin :: Percent -> Percent -> Percent
max :: Percent -> Percent -> Percent
$cmax :: Percent -> Percent -> Percent
>= :: Percent -> Percent -> Bool
$c>= :: Percent -> Percent -> Bool
> :: Percent -> Percent -> Bool
$c> :: Percent -> Percent -> Bool
<= :: Percent -> Percent -> Bool
$c<= :: Percent -> Percent -> Bool
< :: Percent -> Percent -> Bool
$c< :: Percent -> Percent -> Bool
compare :: Percent -> Percent -> Ordering
$ccompare :: Percent -> Percent -> Ordering
$cp1Ord :: Eq Percent
Ord,Integer -> Percent
Percent -> Percent
Percent -> Percent -> Percent
(Percent -> Percent -> Percent)
-> (Percent -> Percent -> Percent)
-> (Percent -> Percent -> Percent)
-> (Percent -> Percent)
-> (Percent -> Percent)
-> (Percent -> Percent)
-> (Integer -> Percent)
-> Num Percent
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Percent
$cfromInteger :: Integer -> Percent
signum :: Percent -> Percent
$csignum :: Percent -> Percent
abs :: Percent -> Percent
$cabs :: Percent -> Percent
negate :: Percent -> Percent
$cnegate :: Percent -> Percent
* :: Percent -> Percent -> Percent
$c* :: Percent -> Percent -> Percent
- :: Percent -> Percent -> Percent
$c- :: Percent -> Percent -> Percent
+ :: Percent -> Percent -> Percent
$c+ :: Percent -> Percent -> Percent
Num,Num Percent
Ord Percent
Num Percent -> Ord Percent -> (Percent -> Rational) -> Real Percent
Percent -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Percent -> Rational
$ctoRational :: Percent -> Rational
$cp2Real :: Ord Percent
$cp1Real :: Num Percent
Real,Num Percent
Num Percent
-> (Percent -> Percent -> Percent)
-> (Percent -> Percent)
-> (Rational -> Percent)
-> Fractional Percent
Rational -> Percent
Percent -> Percent
Percent -> Percent -> Percent
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Percent
$cfromRational :: Rational -> Percent
recip :: Percent -> Percent
$crecip :: Percent -> Percent
/ :: Percent -> Percent -> Percent
$c/ :: Percent -> Percent -> Percent
$cp1Fractional :: Num Percent
Fractional,Fractional Percent
Real Percent
Real Percent
-> Fractional Percent
-> (forall b. Integral b => Percent -> (b, Percent))
-> (forall b. Integral b => Percent -> b)
-> (forall b. Integral b => Percent -> b)
-> (forall b. Integral b => Percent -> b)
-> (forall b. Integral b => Percent -> b)
-> RealFrac Percent
Percent -> b
Percent -> b
Percent -> b
Percent -> b
Percent -> (b, Percent)
forall b. Integral b => Percent -> b
forall b. Integral b => Percent -> (b, Percent)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Percent -> b
$cfloor :: forall b. Integral b => Percent -> b
ceiling :: Percent -> b
$cceiling :: forall b. Integral b => Percent -> b
round :: Percent -> b
$cround :: forall b. Integral b => Percent -> b
truncate :: Percent -> b
$ctruncate :: forall b. Integral b => Percent -> b
properFraction :: Percent -> (b, Percent)
$cproperFraction :: forall b. Integral b => Percent -> (b, Percent)
$cp2RealFrac :: Fractional Percent
$cp1RealFrac :: Real Percent
RealFrac)
instance Show Percent where show :: Percent -> String
show (Percent Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read Percent where readsPrec :: Int -> ReadS Percent
readsPrec Int
i = ((Decimal, String) -> (Percent, String))
-> [(Decimal, String)] -> [(Percent, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> Percent) -> (Decimal, String) -> (Percent, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> Percent
Percent) ([(Decimal, String)] -> [(Percent, String)])
-> (String -> [(Decimal, String)]) -> ReadS Percent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Percent where
    emitXml :: Percent -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep) -> (Percent -> Decimal) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Percent -> Decimal
percent
parsePercent :: String -> P.XParse Percent
parsePercent :: String -> XParse Percent
parsePercent = String -> String -> XParse Percent
forall a. Read a => String -> String -> XParse a
P.xread String
"Percent"

-- | @pitched-value@ /(simple)/
--
-- The pitched-value type represents pictograms for pitched percussion instruments. The chimes and tubular chimes values distinguish the single-line and double-line versions of the pictogram.
data PitchedValue = 
      PitchedValueCelesta -- ^ /celesta/
    | PitchedValueChimes -- ^ /chimes/
    | PitchedValueGlockenspiel -- ^ /glockenspiel/
    | PitchedValueLithophone -- ^ /lithophone/
    | PitchedValueMallet -- ^ /mallet/
    | PitchedValueMarimba -- ^ /marimba/
    | PitchedValueSteelDrums -- ^ /steel drums/
    | PitchedValueTubaphone -- ^ /tubaphone/
    | PitchedValueTubularChimes -- ^ /tubular chimes/
    | PitchedValueVibraphone -- ^ /vibraphone/
    | PitchedValueXylophone -- ^ /xylophone/
    deriving (PitchedValue -> PitchedValue -> Bool
(PitchedValue -> PitchedValue -> Bool)
-> (PitchedValue -> PitchedValue -> Bool) -> Eq PitchedValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PitchedValue -> PitchedValue -> Bool
$c/= :: PitchedValue -> PitchedValue -> Bool
== :: PitchedValue -> PitchedValue -> Bool
$c== :: PitchedValue -> PitchedValue -> Bool
Eq,Typeable,(forall x. PitchedValue -> Rep PitchedValue x)
-> (forall x. Rep PitchedValue x -> PitchedValue)
-> Generic PitchedValue
forall x. Rep PitchedValue x -> PitchedValue
forall x. PitchedValue -> Rep PitchedValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PitchedValue x -> PitchedValue
$cfrom :: forall x. PitchedValue -> Rep PitchedValue x
Generic,Int -> PitchedValue -> ShowS
[PitchedValue] -> ShowS
PitchedValue -> String
(Int -> PitchedValue -> ShowS)
-> (PitchedValue -> String)
-> ([PitchedValue] -> ShowS)
-> Show PitchedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PitchedValue] -> ShowS
$cshowList :: [PitchedValue] -> ShowS
show :: PitchedValue -> String
$cshow :: PitchedValue -> String
showsPrec :: Int -> PitchedValue -> ShowS
$cshowsPrec :: Int -> PitchedValue -> ShowS
Show,Eq PitchedValue
Eq PitchedValue
-> (PitchedValue -> PitchedValue -> Ordering)
-> (PitchedValue -> PitchedValue -> Bool)
-> (PitchedValue -> PitchedValue -> Bool)
-> (PitchedValue -> PitchedValue -> Bool)
-> (PitchedValue -> PitchedValue -> Bool)
-> (PitchedValue -> PitchedValue -> PitchedValue)
-> (PitchedValue -> PitchedValue -> PitchedValue)
-> Ord PitchedValue
PitchedValue -> PitchedValue -> Bool
PitchedValue -> PitchedValue -> Ordering
PitchedValue -> PitchedValue -> PitchedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PitchedValue -> PitchedValue -> PitchedValue
$cmin :: PitchedValue -> PitchedValue -> PitchedValue
max :: PitchedValue -> PitchedValue -> PitchedValue
$cmax :: PitchedValue -> PitchedValue -> PitchedValue
>= :: PitchedValue -> PitchedValue -> Bool
$c>= :: PitchedValue -> PitchedValue -> Bool
> :: PitchedValue -> PitchedValue -> Bool
$c> :: PitchedValue -> PitchedValue -> Bool
<= :: PitchedValue -> PitchedValue -> Bool
$c<= :: PitchedValue -> PitchedValue -> Bool
< :: PitchedValue -> PitchedValue -> Bool
$c< :: PitchedValue -> PitchedValue -> Bool
compare :: PitchedValue -> PitchedValue -> Ordering
$ccompare :: PitchedValue -> PitchedValue -> Ordering
$cp1Ord :: Eq PitchedValue
Ord,Int -> PitchedValue
PitchedValue -> Int
PitchedValue -> [PitchedValue]
PitchedValue -> PitchedValue
PitchedValue -> PitchedValue -> [PitchedValue]
PitchedValue -> PitchedValue -> PitchedValue -> [PitchedValue]
(PitchedValue -> PitchedValue)
-> (PitchedValue -> PitchedValue)
-> (Int -> PitchedValue)
-> (PitchedValue -> Int)
-> (PitchedValue -> [PitchedValue])
-> (PitchedValue -> PitchedValue -> [PitchedValue])
-> (PitchedValue -> PitchedValue -> [PitchedValue])
-> (PitchedValue -> PitchedValue -> PitchedValue -> [PitchedValue])
-> Enum PitchedValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PitchedValue -> PitchedValue -> PitchedValue -> [PitchedValue]
$cenumFromThenTo :: PitchedValue -> PitchedValue -> PitchedValue -> [PitchedValue]
enumFromTo :: PitchedValue -> PitchedValue -> [PitchedValue]
$cenumFromTo :: PitchedValue -> PitchedValue -> [PitchedValue]
enumFromThen :: PitchedValue -> PitchedValue -> [PitchedValue]
$cenumFromThen :: PitchedValue -> PitchedValue -> [PitchedValue]
enumFrom :: PitchedValue -> [PitchedValue]
$cenumFrom :: PitchedValue -> [PitchedValue]
fromEnum :: PitchedValue -> Int
$cfromEnum :: PitchedValue -> Int
toEnum :: Int -> PitchedValue
$ctoEnum :: Int -> PitchedValue
pred :: PitchedValue -> PitchedValue
$cpred :: PitchedValue -> PitchedValue
succ :: PitchedValue -> PitchedValue
$csucc :: PitchedValue -> PitchedValue
Enum,PitchedValue
PitchedValue -> PitchedValue -> Bounded PitchedValue
forall a. a -> a -> Bounded a
maxBound :: PitchedValue
$cmaxBound :: PitchedValue
minBound :: PitchedValue
$cminBound :: PitchedValue
Bounded)
instance EmitXml PitchedValue where
    emitXml :: PitchedValue -> XmlRep
emitXml PitchedValue
PitchedValueCelesta = String -> XmlRep
XLit String
"celesta"
    emitXml PitchedValue
PitchedValueChimes = String -> XmlRep
XLit String
"chimes"
    emitXml PitchedValue
PitchedValueGlockenspiel = String -> XmlRep
XLit String
"glockenspiel"
    emitXml PitchedValue
PitchedValueLithophone = String -> XmlRep
XLit String
"lithophone"
    emitXml PitchedValue
PitchedValueMallet = String -> XmlRep
XLit String
"mallet"
    emitXml PitchedValue
PitchedValueMarimba = String -> XmlRep
XLit String
"marimba"
    emitXml PitchedValue
PitchedValueSteelDrums = String -> XmlRep
XLit String
"steel drums"
    emitXml PitchedValue
PitchedValueTubaphone = String -> XmlRep
XLit String
"tubaphone"
    emitXml PitchedValue
PitchedValueTubularChimes = String -> XmlRep
XLit String
"tubular chimes"
    emitXml PitchedValue
PitchedValueVibraphone = String -> XmlRep
XLit String
"vibraphone"
    emitXml PitchedValue
PitchedValueXylophone = String -> XmlRep
XLit String
"xylophone"
parsePitchedValue :: String -> P.XParse PitchedValue
parsePitchedValue :: String -> XParse PitchedValue
parsePitchedValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"celesta" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueCelesta
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"chimes" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueChimes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"glockenspiel" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueGlockenspiel
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"lithophone" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueLithophone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mallet" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueMallet
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"marimba" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueMarimba
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"steel drums" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueSteelDrums
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tubaphone" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueTubaphone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"tubular chimes" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueTubularChimes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"vibraphone" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueVibraphone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xylophone" = PitchedValue -> XParse PitchedValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PitchedValue -> XParse PitchedValue)
-> PitchedValue -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ PitchedValue
PitchedValueXylophone
        | Bool
otherwise = String -> XParse PitchedValue
forall a. String -> XParse a
P.xfail (String -> XParse PitchedValue) -> String -> XParse PitchedValue
forall a b. (a -> b) -> a -> b
$ String
"PitchedValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @positive-divisions@ /(simple)/
--
-- The positive-divisions type restricts divisions values to positive numbers.
newtype PositiveDivisions = PositiveDivisions { PositiveDivisions -> Divisions
positiveDivisions :: Divisions }
    deriving (PositiveDivisions -> PositiveDivisions -> Bool
(PositiveDivisions -> PositiveDivisions -> Bool)
-> (PositiveDivisions -> PositiveDivisions -> Bool)
-> Eq PositiveDivisions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveDivisions -> PositiveDivisions -> Bool
$c/= :: PositiveDivisions -> PositiveDivisions -> Bool
== :: PositiveDivisions -> PositiveDivisions -> Bool
$c== :: PositiveDivisions -> PositiveDivisions -> Bool
Eq,Typeable,(forall x. PositiveDivisions -> Rep PositiveDivisions x)
-> (forall x. Rep PositiveDivisions x -> PositiveDivisions)
-> Generic PositiveDivisions
forall x. Rep PositiveDivisions x -> PositiveDivisions
forall x. PositiveDivisions -> Rep PositiveDivisions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositiveDivisions x -> PositiveDivisions
$cfrom :: forall x. PositiveDivisions -> Rep PositiveDivisions x
Generic,Eq PositiveDivisions
Eq PositiveDivisions
-> (PositiveDivisions -> PositiveDivisions -> Ordering)
-> (PositiveDivisions -> PositiveDivisions -> Bool)
-> (PositiveDivisions -> PositiveDivisions -> Bool)
-> (PositiveDivisions -> PositiveDivisions -> Bool)
-> (PositiveDivisions -> PositiveDivisions -> Bool)
-> (PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> Ord PositiveDivisions
PositiveDivisions -> PositiveDivisions -> Bool
PositiveDivisions -> PositiveDivisions -> Ordering
PositiveDivisions -> PositiveDivisions -> PositiveDivisions
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$cmin :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
max :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$cmax :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
>= :: PositiveDivisions -> PositiveDivisions -> Bool
$c>= :: PositiveDivisions -> PositiveDivisions -> Bool
> :: PositiveDivisions -> PositiveDivisions -> Bool
$c> :: PositiveDivisions -> PositiveDivisions -> Bool
<= :: PositiveDivisions -> PositiveDivisions -> Bool
$c<= :: PositiveDivisions -> PositiveDivisions -> Bool
< :: PositiveDivisions -> PositiveDivisions -> Bool
$c< :: PositiveDivisions -> PositiveDivisions -> Bool
compare :: PositiveDivisions -> PositiveDivisions -> Ordering
$ccompare :: PositiveDivisions -> PositiveDivisions -> Ordering
$cp1Ord :: Eq PositiveDivisions
Ord,Integer -> PositiveDivisions
PositiveDivisions -> PositiveDivisions
PositiveDivisions -> PositiveDivisions -> PositiveDivisions
(PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions)
-> (Integer -> PositiveDivisions)
-> Num PositiveDivisions
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PositiveDivisions
$cfromInteger :: Integer -> PositiveDivisions
signum :: PositiveDivisions -> PositiveDivisions
$csignum :: PositiveDivisions -> PositiveDivisions
abs :: PositiveDivisions -> PositiveDivisions
$cabs :: PositiveDivisions -> PositiveDivisions
negate :: PositiveDivisions -> PositiveDivisions
$cnegate :: PositiveDivisions -> PositiveDivisions
* :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$c* :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
- :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$c- :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
+ :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$c+ :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
Num,Num PositiveDivisions
Ord PositiveDivisions
Num PositiveDivisions
-> Ord PositiveDivisions
-> (PositiveDivisions -> Rational)
-> Real PositiveDivisions
PositiveDivisions -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: PositiveDivisions -> Rational
$ctoRational :: PositiveDivisions -> Rational
$cp2Real :: Ord PositiveDivisions
$cp1Real :: Num PositiveDivisions
Real,Num PositiveDivisions
Num PositiveDivisions
-> (PositiveDivisions -> PositiveDivisions -> PositiveDivisions)
-> (PositiveDivisions -> PositiveDivisions)
-> (Rational -> PositiveDivisions)
-> Fractional PositiveDivisions
Rational -> PositiveDivisions
PositiveDivisions -> PositiveDivisions
PositiveDivisions -> PositiveDivisions -> PositiveDivisions
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> PositiveDivisions
$cfromRational :: Rational -> PositiveDivisions
recip :: PositiveDivisions -> PositiveDivisions
$crecip :: PositiveDivisions -> PositiveDivisions
/ :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$c/ :: PositiveDivisions -> PositiveDivisions -> PositiveDivisions
$cp1Fractional :: Num PositiveDivisions
Fractional,Fractional PositiveDivisions
Real PositiveDivisions
Real PositiveDivisions
-> Fractional PositiveDivisions
-> (forall b.
    Integral b =>
    PositiveDivisions -> (b, PositiveDivisions))
-> (forall b. Integral b => PositiveDivisions -> b)
-> (forall b. Integral b => PositiveDivisions -> b)
-> (forall b. Integral b => PositiveDivisions -> b)
-> (forall b. Integral b => PositiveDivisions -> b)
-> RealFrac PositiveDivisions
PositiveDivisions -> b
PositiveDivisions -> b
PositiveDivisions -> b
PositiveDivisions -> b
PositiveDivisions -> (b, PositiveDivisions)
forall b. Integral b => PositiveDivisions -> b
forall b. Integral b => PositiveDivisions -> (b, PositiveDivisions)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: PositiveDivisions -> b
$cfloor :: forall b. Integral b => PositiveDivisions -> b
ceiling :: PositiveDivisions -> b
$cceiling :: forall b. Integral b => PositiveDivisions -> b
round :: PositiveDivisions -> b
$cround :: forall b. Integral b => PositiveDivisions -> b
truncate :: PositiveDivisions -> b
$ctruncate :: forall b. Integral b => PositiveDivisions -> b
properFraction :: PositiveDivisions -> (b, PositiveDivisions)
$cproperFraction :: forall b. Integral b => PositiveDivisions -> (b, PositiveDivisions)
$cp2RealFrac :: Fractional PositiveDivisions
$cp1RealFrac :: Real PositiveDivisions
RealFrac)
instance Show PositiveDivisions where show :: PositiveDivisions -> String
show (PositiveDivisions Divisions
a) = Divisions -> String
forall a. Show a => a -> String
show Divisions
a
instance Read PositiveDivisions where readsPrec :: Int -> ReadS PositiveDivisions
readsPrec Int
i = ((Divisions, String) -> (PositiveDivisions, String))
-> [(Divisions, String)] -> [(PositiveDivisions, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Divisions -> PositiveDivisions)
-> (Divisions, String) -> (PositiveDivisions, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Divisions -> PositiveDivisions
PositiveDivisions) ([(Divisions, String)] -> [(PositiveDivisions, String)])
-> ReadS Divisions -> ReadS PositiveDivisions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS Divisions
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml PositiveDivisions where
    emitXml :: PositiveDivisions -> XmlRep
emitXml = Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Divisions -> XmlRep)
-> (PositiveDivisions -> Divisions) -> PositiveDivisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveDivisions -> Divisions
positiveDivisions
parsePositiveDivisions :: String -> P.XParse PositiveDivisions
parsePositiveDivisions :: String -> XParse PositiveDivisions
parsePositiveDivisions = String -> String -> XParse PositiveDivisions
forall a. Read a => String -> String -> XParse a
P.xread String
"PositiveDivisions"

-- | @positive-integer-or-empty@ /(simple)/
--
-- The positive-integer-or-empty values can be either a positive integer or an empty string.
data PositiveIntegerOrEmpty = 
      PositiveIntegerOrEmptyPositiveInteger {
          PositiveIntegerOrEmpty -> PositiveInteger
positiveIntegerOrEmpty1 :: PositiveInteger
       }
    | PositiveIntegerOrEmptyPositiveIntegerOrEmpty {
          PositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
positiveIntegerOrEmpty2 :: SumPositiveIntegerOrEmpty
       }
    deriving (PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool
(PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool)
-> (PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool)
-> Eq PositiveIntegerOrEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool
$c/= :: PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool
== :: PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool
$c== :: PositiveIntegerOrEmpty -> PositiveIntegerOrEmpty -> Bool
Eq,Typeable,(forall x. PositiveIntegerOrEmpty -> Rep PositiveIntegerOrEmpty x)
-> (forall x.
    Rep PositiveIntegerOrEmpty x -> PositiveIntegerOrEmpty)
-> Generic PositiveIntegerOrEmpty
forall x. Rep PositiveIntegerOrEmpty x -> PositiveIntegerOrEmpty
forall x. PositiveIntegerOrEmpty -> Rep PositiveIntegerOrEmpty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositiveIntegerOrEmpty x -> PositiveIntegerOrEmpty
$cfrom :: forall x. PositiveIntegerOrEmpty -> Rep PositiveIntegerOrEmpty x
Generic,Int -> PositiveIntegerOrEmpty -> ShowS
[PositiveIntegerOrEmpty] -> ShowS
PositiveIntegerOrEmpty -> String
(Int -> PositiveIntegerOrEmpty -> ShowS)
-> (PositiveIntegerOrEmpty -> String)
-> ([PositiveIntegerOrEmpty] -> ShowS)
-> Show PositiveIntegerOrEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositiveIntegerOrEmpty] -> ShowS
$cshowList :: [PositiveIntegerOrEmpty] -> ShowS
show :: PositiveIntegerOrEmpty -> String
$cshow :: PositiveIntegerOrEmpty -> String
showsPrec :: Int -> PositiveIntegerOrEmpty -> ShowS
$cshowsPrec :: Int -> PositiveIntegerOrEmpty -> ShowS
Show)
instance EmitXml PositiveIntegerOrEmpty where
    emitXml :: PositiveIntegerOrEmpty -> XmlRep
emitXml (PositiveIntegerOrEmptyPositiveInteger PositiveInteger
a) = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
a
    emitXml (PositiveIntegerOrEmptyPositiveIntegerOrEmpty SumPositiveIntegerOrEmpty
a) = SumPositiveIntegerOrEmpty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SumPositiveIntegerOrEmpty
a
parsePositiveIntegerOrEmpty :: String -> P.XParse PositiveIntegerOrEmpty
parsePositiveIntegerOrEmpty :: String -> XParse PositiveIntegerOrEmpty
parsePositiveIntegerOrEmpty String
s = 
      PositiveInteger -> PositiveIntegerOrEmpty
PositiveIntegerOrEmptyPositiveInteger
        (PositiveInteger -> PositiveIntegerOrEmpty)
-> XParse PositiveInteger -> XParse PositiveIntegerOrEmpty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse PositiveInteger
parsePositiveInteger String
s
      XParse PositiveIntegerOrEmpty
-> XParse PositiveIntegerOrEmpty -> XParse PositiveIntegerOrEmpty
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SumPositiveIntegerOrEmpty -> PositiveIntegerOrEmpty
PositiveIntegerOrEmptyPositiveIntegerOrEmpty
        (SumPositiveIntegerOrEmpty -> PositiveIntegerOrEmpty)
-> XParse SumPositiveIntegerOrEmpty
-> XParse PositiveIntegerOrEmpty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse SumPositiveIntegerOrEmpty
parseSumPositiveIntegerOrEmpty String
s


-- | @xs:positiveInteger@ /(simple)/
newtype PositiveInteger = PositiveInteger { PositiveInteger -> NonNegativeInteger
positiveInteger :: NonNegativeInteger }
    deriving (PositiveInteger -> PositiveInteger -> Bool
(PositiveInteger -> PositiveInteger -> Bool)
-> (PositiveInteger -> PositiveInteger -> Bool)
-> Eq PositiveInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositiveInteger -> PositiveInteger -> Bool
$c/= :: PositiveInteger -> PositiveInteger -> Bool
== :: PositiveInteger -> PositiveInteger -> Bool
$c== :: PositiveInteger -> PositiveInteger -> Bool
Eq,Typeable,(forall x. PositiveInteger -> Rep PositiveInteger x)
-> (forall x. Rep PositiveInteger x -> PositiveInteger)
-> Generic PositiveInteger
forall x. Rep PositiveInteger x -> PositiveInteger
forall x. PositiveInteger -> Rep PositiveInteger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositiveInteger x -> PositiveInteger
$cfrom :: forall x. PositiveInteger -> Rep PositiveInteger x
Generic,Eq PositiveInteger
Eq PositiveInteger
-> (PositiveInteger -> PositiveInteger -> Ordering)
-> (PositiveInteger -> PositiveInteger -> Bool)
-> (PositiveInteger -> PositiveInteger -> Bool)
-> (PositiveInteger -> PositiveInteger -> Bool)
-> (PositiveInteger -> PositiveInteger -> Bool)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> Ord PositiveInteger
PositiveInteger -> PositiveInteger -> Bool
PositiveInteger -> PositiveInteger -> Ordering
PositiveInteger -> PositiveInteger -> PositiveInteger
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cmin :: PositiveInteger -> PositiveInteger -> PositiveInteger
max :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cmax :: PositiveInteger -> PositiveInteger -> PositiveInteger
>= :: PositiveInteger -> PositiveInteger -> Bool
$c>= :: PositiveInteger -> PositiveInteger -> Bool
> :: PositiveInteger -> PositiveInteger -> Bool
$c> :: PositiveInteger -> PositiveInteger -> Bool
<= :: PositiveInteger -> PositiveInteger -> Bool
$c<= :: PositiveInteger -> PositiveInteger -> Bool
< :: PositiveInteger -> PositiveInteger -> Bool
$c< :: PositiveInteger -> PositiveInteger -> Bool
compare :: PositiveInteger -> PositiveInteger -> Ordering
$ccompare :: PositiveInteger -> PositiveInteger -> Ordering
$cp1Ord :: Eq PositiveInteger
Ord,PositiveInteger
PositiveInteger -> PositiveInteger -> Bounded PositiveInteger
forall a. a -> a -> Bounded a
maxBound :: PositiveInteger
$cmaxBound :: PositiveInteger
minBound :: PositiveInteger
$cminBound :: PositiveInteger
Bounded,Int -> PositiveInteger
PositiveInteger -> Int
PositiveInteger -> [PositiveInteger]
PositiveInteger -> PositiveInteger
PositiveInteger -> PositiveInteger -> [PositiveInteger]
PositiveInteger
-> PositiveInteger -> PositiveInteger -> [PositiveInteger]
(PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger)
-> (Int -> PositiveInteger)
-> (PositiveInteger -> Int)
-> (PositiveInteger -> [PositiveInteger])
-> (PositiveInteger -> PositiveInteger -> [PositiveInteger])
-> (PositiveInteger -> PositiveInteger -> [PositiveInteger])
-> (PositiveInteger
    -> PositiveInteger -> PositiveInteger -> [PositiveInteger])
-> Enum PositiveInteger
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PositiveInteger
-> PositiveInteger -> PositiveInteger -> [PositiveInteger]
$cenumFromThenTo :: PositiveInteger
-> PositiveInteger -> PositiveInteger -> [PositiveInteger]
enumFromTo :: PositiveInteger -> PositiveInteger -> [PositiveInteger]
$cenumFromTo :: PositiveInteger -> PositiveInteger -> [PositiveInteger]
enumFromThen :: PositiveInteger -> PositiveInteger -> [PositiveInteger]
$cenumFromThen :: PositiveInteger -> PositiveInteger -> [PositiveInteger]
enumFrom :: PositiveInteger -> [PositiveInteger]
$cenumFrom :: PositiveInteger -> [PositiveInteger]
fromEnum :: PositiveInteger -> Int
$cfromEnum :: PositiveInteger -> Int
toEnum :: Int -> PositiveInteger
$ctoEnum :: Int -> PositiveInteger
pred :: PositiveInteger -> PositiveInteger
$cpred :: PositiveInteger -> PositiveInteger
succ :: PositiveInteger -> PositiveInteger
$csucc :: PositiveInteger -> PositiveInteger
Enum,Integer -> PositiveInteger
PositiveInteger -> PositiveInteger
PositiveInteger -> PositiveInteger -> PositiveInteger
(PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger)
-> (Integer -> PositiveInteger)
-> Num PositiveInteger
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PositiveInteger
$cfromInteger :: Integer -> PositiveInteger
signum :: PositiveInteger -> PositiveInteger
$csignum :: PositiveInteger -> PositiveInteger
abs :: PositiveInteger -> PositiveInteger
$cabs :: PositiveInteger -> PositiveInteger
negate :: PositiveInteger -> PositiveInteger
$cnegate :: PositiveInteger -> PositiveInteger
* :: PositiveInteger -> PositiveInteger -> PositiveInteger
$c* :: PositiveInteger -> PositiveInteger -> PositiveInteger
- :: PositiveInteger -> PositiveInteger -> PositiveInteger
$c- :: PositiveInteger -> PositiveInteger -> PositiveInteger
+ :: PositiveInteger -> PositiveInteger -> PositiveInteger
$c+ :: PositiveInteger -> PositiveInteger -> PositiveInteger
Num,Num PositiveInteger
Ord PositiveInteger
Num PositiveInteger
-> Ord PositiveInteger
-> (PositiveInteger -> Rational)
-> Real PositiveInteger
PositiveInteger -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: PositiveInteger -> Rational
$ctoRational :: PositiveInteger -> Rational
$cp2Real :: Ord PositiveInteger
$cp1Real :: Num PositiveInteger
Real,Enum PositiveInteger
Real PositiveInteger
Real PositiveInteger
-> Enum PositiveInteger
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger -> PositiveInteger -> PositiveInteger)
-> (PositiveInteger
    -> PositiveInteger -> (PositiveInteger, PositiveInteger))
-> (PositiveInteger
    -> PositiveInteger -> (PositiveInteger, PositiveInteger))
-> (PositiveInteger -> Integer)
-> Integral PositiveInteger
PositiveInteger -> Integer
PositiveInteger
-> PositiveInteger -> (PositiveInteger, PositiveInteger)
PositiveInteger -> PositiveInteger -> PositiveInteger
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: PositiveInteger -> Integer
$ctoInteger :: PositiveInteger -> Integer
divMod :: PositiveInteger
-> PositiveInteger -> (PositiveInteger, PositiveInteger)
$cdivMod :: PositiveInteger
-> PositiveInteger -> (PositiveInteger, PositiveInteger)
quotRem :: PositiveInteger
-> PositiveInteger -> (PositiveInteger, PositiveInteger)
$cquotRem :: PositiveInteger
-> PositiveInteger -> (PositiveInteger, PositiveInteger)
mod :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cmod :: PositiveInteger -> PositiveInteger -> PositiveInteger
div :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cdiv :: PositiveInteger -> PositiveInteger -> PositiveInteger
rem :: PositiveInteger -> PositiveInteger -> PositiveInteger
$crem :: PositiveInteger -> PositiveInteger -> PositiveInteger
quot :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cquot :: PositiveInteger -> PositiveInteger -> PositiveInteger
$cp2Integral :: Enum PositiveInteger
$cp1Integral :: Real PositiveInteger
Integral)
instance Show PositiveInteger where show :: PositiveInteger -> String
show (PositiveInteger NonNegativeInteger
a) = NonNegativeInteger -> String
forall a. Show a => a -> String
show NonNegativeInteger
a
instance Read PositiveInteger where readsPrec :: Int -> String -> [(PositiveInteger, String)]
readsPrec Int
i = ((NonNegativeInteger, String) -> (PositiveInteger, String))
-> [(NonNegativeInteger, String)] -> [(PositiveInteger, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NonNegativeInteger -> PositiveInteger)
-> (NonNegativeInteger, String) -> (PositiveInteger, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NonNegativeInteger -> PositiveInteger
PositiveInteger) ([(NonNegativeInteger, String)] -> [(PositiveInteger, String)])
-> ReadS NonNegativeInteger
-> String
-> [(PositiveInteger, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS NonNegativeInteger
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml PositiveInteger where
    emitXml :: PositiveInteger -> XmlRep
emitXml = NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NonNegativeInteger -> XmlRep)
-> (PositiveInteger -> NonNegativeInteger)
-> PositiveInteger
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositiveInteger -> NonNegativeInteger
positiveInteger
parsePositiveInteger :: String -> P.XParse PositiveInteger
parsePositiveInteger :: String -> XParse PositiveInteger
parsePositiveInteger = String -> String -> XParse PositiveInteger
forall a. Read a => String -> String -> XParse a
P.xread String
"PositiveInteger"

-- | @principal-voice-symbol@ /(simple)/
--
-- The principal-voice-symbol type represents the type of symbol used to indicate the start of a principal or secondary voice. The "plain" value represents a plain square bracket. The value of "none" is used for analysis markup when the principal-voice element does not have a corresponding appearance in the score.
data PrincipalVoiceSymbol = 
      PrincipalVoiceSymbolHauptstimme -- ^ /Hauptstimme/
    | PrincipalVoiceSymbolNebenstimme -- ^ /Nebenstimme/
    | PrincipalVoiceSymbolPlain -- ^ /plain/
    | PrincipalVoiceSymbolNone -- ^ /none/
    deriving (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
(PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> Eq PrincipalVoiceSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c/= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
== :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c== :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
Eq,Typeable,(forall x. PrincipalVoiceSymbol -> Rep PrincipalVoiceSymbol x)
-> (forall x. Rep PrincipalVoiceSymbol x -> PrincipalVoiceSymbol)
-> Generic PrincipalVoiceSymbol
forall x. Rep PrincipalVoiceSymbol x -> PrincipalVoiceSymbol
forall x. PrincipalVoiceSymbol -> Rep PrincipalVoiceSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrincipalVoiceSymbol x -> PrincipalVoiceSymbol
$cfrom :: forall x. PrincipalVoiceSymbol -> Rep PrincipalVoiceSymbol x
Generic,Int -> PrincipalVoiceSymbol -> ShowS
[PrincipalVoiceSymbol] -> ShowS
PrincipalVoiceSymbol -> String
(Int -> PrincipalVoiceSymbol -> ShowS)
-> (PrincipalVoiceSymbol -> String)
-> ([PrincipalVoiceSymbol] -> ShowS)
-> Show PrincipalVoiceSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrincipalVoiceSymbol] -> ShowS
$cshowList :: [PrincipalVoiceSymbol] -> ShowS
show :: PrincipalVoiceSymbol -> String
$cshow :: PrincipalVoiceSymbol -> String
showsPrec :: Int -> PrincipalVoiceSymbol -> ShowS
$cshowsPrec :: Int -> PrincipalVoiceSymbol -> ShowS
Show,Eq PrincipalVoiceSymbol
Eq PrincipalVoiceSymbol
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Ordering)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool)
-> (PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol -> PrincipalVoiceSymbol)
-> (PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol -> PrincipalVoiceSymbol)
-> Ord PrincipalVoiceSymbol
PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Ordering
PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> PrincipalVoiceSymbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> PrincipalVoiceSymbol
$cmin :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> PrincipalVoiceSymbol
max :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> PrincipalVoiceSymbol
$cmax :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> PrincipalVoiceSymbol
>= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c>= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
> :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c> :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
<= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c<= :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
< :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
$c< :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Bool
compare :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Ordering
$ccompare :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol -> Ordering
$cp1Ord :: Eq PrincipalVoiceSymbol
Ord,Int -> PrincipalVoiceSymbol
PrincipalVoiceSymbol -> Int
PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
PrincipalVoiceSymbol -> PrincipalVoiceSymbol
PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> [PrincipalVoiceSymbol]
(PrincipalVoiceSymbol -> PrincipalVoiceSymbol)
-> (PrincipalVoiceSymbol -> PrincipalVoiceSymbol)
-> (Int -> PrincipalVoiceSymbol)
-> (PrincipalVoiceSymbol -> Int)
-> (PrincipalVoiceSymbol -> [PrincipalVoiceSymbol])
-> (PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol])
-> (PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol])
-> (PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol
    -> PrincipalVoiceSymbol
    -> [PrincipalVoiceSymbol])
-> Enum PrincipalVoiceSymbol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> [PrincipalVoiceSymbol]
$cenumFromThenTo :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> PrincipalVoiceSymbol
-> [PrincipalVoiceSymbol]
enumFromTo :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
$cenumFromTo :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
enumFromThen :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
$cenumFromThen :: PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
enumFrom :: PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
$cenumFrom :: PrincipalVoiceSymbol -> [PrincipalVoiceSymbol]
fromEnum :: PrincipalVoiceSymbol -> Int
$cfromEnum :: PrincipalVoiceSymbol -> Int
toEnum :: Int -> PrincipalVoiceSymbol
$ctoEnum :: Int -> PrincipalVoiceSymbol
pred :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol
$cpred :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol
succ :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol
$csucc :: PrincipalVoiceSymbol -> PrincipalVoiceSymbol
Enum,PrincipalVoiceSymbol
PrincipalVoiceSymbol
-> PrincipalVoiceSymbol -> Bounded PrincipalVoiceSymbol
forall a. a -> a -> Bounded a
maxBound :: PrincipalVoiceSymbol
$cmaxBound :: PrincipalVoiceSymbol
minBound :: PrincipalVoiceSymbol
$cminBound :: PrincipalVoiceSymbol
Bounded)
instance EmitXml PrincipalVoiceSymbol where
    emitXml :: PrincipalVoiceSymbol -> XmlRep
emitXml PrincipalVoiceSymbol
PrincipalVoiceSymbolHauptstimme = String -> XmlRep
XLit String
"Hauptstimme"
    emitXml PrincipalVoiceSymbol
PrincipalVoiceSymbolNebenstimme = String -> XmlRep
XLit String
"Nebenstimme"
    emitXml PrincipalVoiceSymbol
PrincipalVoiceSymbolPlain = String -> XmlRep
XLit String
"plain"
    emitXml PrincipalVoiceSymbol
PrincipalVoiceSymbolNone = String -> XmlRep
XLit String
"none"
parsePrincipalVoiceSymbol :: String -> P.XParse PrincipalVoiceSymbol
parsePrincipalVoiceSymbol :: String -> XParse PrincipalVoiceSymbol
parsePrincipalVoiceSymbol String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Hauptstimme" = PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol)
-> PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall a b. (a -> b) -> a -> b
$ PrincipalVoiceSymbol
PrincipalVoiceSymbolHauptstimme
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Nebenstimme" = PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol)
-> PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall a b. (a -> b) -> a -> b
$ PrincipalVoiceSymbol
PrincipalVoiceSymbolNebenstimme
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"plain" = PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol)
-> PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall a b. (a -> b) -> a -> b
$ PrincipalVoiceSymbol
PrincipalVoiceSymbolPlain
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol)
-> PrincipalVoiceSymbol -> XParse PrincipalVoiceSymbol
forall a b. (a -> b) -> a -> b
$ PrincipalVoiceSymbol
PrincipalVoiceSymbolNone
        | Bool
otherwise = String -> XParse PrincipalVoiceSymbol
forall a. String -> XParse a
P.xfail (String -> XParse PrincipalVoiceSymbol)
-> String -> XParse PrincipalVoiceSymbol
forall a b. (a -> b) -> a -> b
$ String
"PrincipalVoiceSymbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @right-left-middle@ /(simple)/
--
-- The right-left-middle type is used to specify barline location.
data RightLeftMiddle = 
      RightLeftMiddleRight -- ^ /right/
    | RightLeftMiddleLeft -- ^ /left/
    | RightLeftMiddleMiddle -- ^ /middle/
    deriving (RightLeftMiddle -> RightLeftMiddle -> Bool
(RightLeftMiddle -> RightLeftMiddle -> Bool)
-> (RightLeftMiddle -> RightLeftMiddle -> Bool)
-> Eq RightLeftMiddle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c/= :: RightLeftMiddle -> RightLeftMiddle -> Bool
== :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c== :: RightLeftMiddle -> RightLeftMiddle -> Bool
Eq,Typeable,(forall x. RightLeftMiddle -> Rep RightLeftMiddle x)
-> (forall x. Rep RightLeftMiddle x -> RightLeftMiddle)
-> Generic RightLeftMiddle
forall x. Rep RightLeftMiddle x -> RightLeftMiddle
forall x. RightLeftMiddle -> Rep RightLeftMiddle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RightLeftMiddle x -> RightLeftMiddle
$cfrom :: forall x. RightLeftMiddle -> Rep RightLeftMiddle x
Generic,Int -> RightLeftMiddle -> ShowS
[RightLeftMiddle] -> ShowS
RightLeftMiddle -> String
(Int -> RightLeftMiddle -> ShowS)
-> (RightLeftMiddle -> String)
-> ([RightLeftMiddle] -> ShowS)
-> Show RightLeftMiddle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RightLeftMiddle] -> ShowS
$cshowList :: [RightLeftMiddle] -> ShowS
show :: RightLeftMiddle -> String
$cshow :: RightLeftMiddle -> String
showsPrec :: Int -> RightLeftMiddle -> ShowS
$cshowsPrec :: Int -> RightLeftMiddle -> ShowS
Show,Eq RightLeftMiddle
Eq RightLeftMiddle
-> (RightLeftMiddle -> RightLeftMiddle -> Ordering)
-> (RightLeftMiddle -> RightLeftMiddle -> Bool)
-> (RightLeftMiddle -> RightLeftMiddle -> Bool)
-> (RightLeftMiddle -> RightLeftMiddle -> Bool)
-> (RightLeftMiddle -> RightLeftMiddle -> Bool)
-> (RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle)
-> (RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle)
-> Ord RightLeftMiddle
RightLeftMiddle -> RightLeftMiddle -> Bool
RightLeftMiddle -> RightLeftMiddle -> Ordering
RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle
$cmin :: RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle
max :: RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle
$cmax :: RightLeftMiddle -> RightLeftMiddle -> RightLeftMiddle
>= :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c>= :: RightLeftMiddle -> RightLeftMiddle -> Bool
> :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c> :: RightLeftMiddle -> RightLeftMiddle -> Bool
<= :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c<= :: RightLeftMiddle -> RightLeftMiddle -> Bool
< :: RightLeftMiddle -> RightLeftMiddle -> Bool
$c< :: RightLeftMiddle -> RightLeftMiddle -> Bool
compare :: RightLeftMiddle -> RightLeftMiddle -> Ordering
$ccompare :: RightLeftMiddle -> RightLeftMiddle -> Ordering
$cp1Ord :: Eq RightLeftMiddle
Ord,Int -> RightLeftMiddle
RightLeftMiddle -> Int
RightLeftMiddle -> [RightLeftMiddle]
RightLeftMiddle -> RightLeftMiddle
RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
RightLeftMiddle
-> RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
(RightLeftMiddle -> RightLeftMiddle)
-> (RightLeftMiddle -> RightLeftMiddle)
-> (Int -> RightLeftMiddle)
-> (RightLeftMiddle -> Int)
-> (RightLeftMiddle -> [RightLeftMiddle])
-> (RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle])
-> (RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle])
-> (RightLeftMiddle
    -> RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle])
-> Enum RightLeftMiddle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RightLeftMiddle
-> RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
$cenumFromThenTo :: RightLeftMiddle
-> RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
enumFromTo :: RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
$cenumFromTo :: RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
enumFromThen :: RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
$cenumFromThen :: RightLeftMiddle -> RightLeftMiddle -> [RightLeftMiddle]
enumFrom :: RightLeftMiddle -> [RightLeftMiddle]
$cenumFrom :: RightLeftMiddle -> [RightLeftMiddle]
fromEnum :: RightLeftMiddle -> Int
$cfromEnum :: RightLeftMiddle -> Int
toEnum :: Int -> RightLeftMiddle
$ctoEnum :: Int -> RightLeftMiddle
pred :: RightLeftMiddle -> RightLeftMiddle
$cpred :: RightLeftMiddle -> RightLeftMiddle
succ :: RightLeftMiddle -> RightLeftMiddle
$csucc :: RightLeftMiddle -> RightLeftMiddle
Enum,RightLeftMiddle
RightLeftMiddle -> RightLeftMiddle -> Bounded RightLeftMiddle
forall a. a -> a -> Bounded a
maxBound :: RightLeftMiddle
$cmaxBound :: RightLeftMiddle
minBound :: RightLeftMiddle
$cminBound :: RightLeftMiddle
Bounded)
instance EmitXml RightLeftMiddle where
    emitXml :: RightLeftMiddle -> XmlRep
emitXml RightLeftMiddle
RightLeftMiddleRight = String -> XmlRep
XLit String
"right"
    emitXml RightLeftMiddle
RightLeftMiddleLeft = String -> XmlRep
XLit String
"left"
    emitXml RightLeftMiddle
RightLeftMiddleMiddle = String -> XmlRep
XLit String
"middle"
parseRightLeftMiddle :: String -> P.XParse RightLeftMiddle
parseRightLeftMiddle :: String -> XParse RightLeftMiddle
parseRightLeftMiddle String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = RightLeftMiddle -> XParse RightLeftMiddle
forall (m :: * -> *) a. Monad m => a -> m a
return (RightLeftMiddle -> XParse RightLeftMiddle)
-> RightLeftMiddle -> XParse RightLeftMiddle
forall a b. (a -> b) -> a -> b
$ RightLeftMiddle
RightLeftMiddleRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = RightLeftMiddle -> XParse RightLeftMiddle
forall (m :: * -> *) a. Monad m => a -> m a
return (RightLeftMiddle -> XParse RightLeftMiddle)
-> RightLeftMiddle -> XParse RightLeftMiddle
forall a b. (a -> b) -> a -> b
$ RightLeftMiddle
RightLeftMiddleLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"middle" = RightLeftMiddle -> XParse RightLeftMiddle
forall (m :: * -> *) a. Monad m => a -> m a
return (RightLeftMiddle -> XParse RightLeftMiddle)
-> RightLeftMiddle -> XParse RightLeftMiddle
forall a b. (a -> b) -> a -> b
$ RightLeftMiddle
RightLeftMiddleMiddle
        | Bool
otherwise = String -> XParse RightLeftMiddle
forall a. String -> XParse a
P.xfail (String -> XParse RightLeftMiddle)
-> String -> XParse RightLeftMiddle
forall a b. (a -> b) -> a -> b
$ String
"RightLeftMiddle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @rotation-degrees@ /(simple)/
--
-- The rotation-degrees type specifies rotation, pan, and elevation values in degrees. Values range from -180 to 180.
newtype RotationDegrees = RotationDegrees { RotationDegrees -> Decimal
rotationDegrees :: Decimal }
    deriving (RotationDegrees -> RotationDegrees -> Bool
(RotationDegrees -> RotationDegrees -> Bool)
-> (RotationDegrees -> RotationDegrees -> Bool)
-> Eq RotationDegrees
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RotationDegrees -> RotationDegrees -> Bool
$c/= :: RotationDegrees -> RotationDegrees -> Bool
== :: RotationDegrees -> RotationDegrees -> Bool
$c== :: RotationDegrees -> RotationDegrees -> Bool
Eq,Typeable,(forall x. RotationDegrees -> Rep RotationDegrees x)
-> (forall x. Rep RotationDegrees x -> RotationDegrees)
-> Generic RotationDegrees
forall x. Rep RotationDegrees x -> RotationDegrees
forall x. RotationDegrees -> Rep RotationDegrees x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RotationDegrees x -> RotationDegrees
$cfrom :: forall x. RotationDegrees -> Rep RotationDegrees x
Generic,Eq RotationDegrees
Eq RotationDegrees
-> (RotationDegrees -> RotationDegrees -> Ordering)
-> (RotationDegrees -> RotationDegrees -> Bool)
-> (RotationDegrees -> RotationDegrees -> Bool)
-> (RotationDegrees -> RotationDegrees -> Bool)
-> (RotationDegrees -> RotationDegrees -> Bool)
-> (RotationDegrees -> RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees -> RotationDegrees)
-> Ord RotationDegrees
RotationDegrees -> RotationDegrees -> Bool
RotationDegrees -> RotationDegrees -> Ordering
RotationDegrees -> RotationDegrees -> RotationDegrees
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RotationDegrees -> RotationDegrees -> RotationDegrees
$cmin :: RotationDegrees -> RotationDegrees -> RotationDegrees
max :: RotationDegrees -> RotationDegrees -> RotationDegrees
$cmax :: RotationDegrees -> RotationDegrees -> RotationDegrees
>= :: RotationDegrees -> RotationDegrees -> Bool
$c>= :: RotationDegrees -> RotationDegrees -> Bool
> :: RotationDegrees -> RotationDegrees -> Bool
$c> :: RotationDegrees -> RotationDegrees -> Bool
<= :: RotationDegrees -> RotationDegrees -> Bool
$c<= :: RotationDegrees -> RotationDegrees -> Bool
< :: RotationDegrees -> RotationDegrees -> Bool
$c< :: RotationDegrees -> RotationDegrees -> Bool
compare :: RotationDegrees -> RotationDegrees -> Ordering
$ccompare :: RotationDegrees -> RotationDegrees -> Ordering
$cp1Ord :: Eq RotationDegrees
Ord,Integer -> RotationDegrees
RotationDegrees -> RotationDegrees
RotationDegrees -> RotationDegrees -> RotationDegrees
(RotationDegrees -> RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees)
-> (Integer -> RotationDegrees)
-> Num RotationDegrees
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> RotationDegrees
$cfromInteger :: Integer -> RotationDegrees
signum :: RotationDegrees -> RotationDegrees
$csignum :: RotationDegrees -> RotationDegrees
abs :: RotationDegrees -> RotationDegrees
$cabs :: RotationDegrees -> RotationDegrees
negate :: RotationDegrees -> RotationDegrees
$cnegate :: RotationDegrees -> RotationDegrees
* :: RotationDegrees -> RotationDegrees -> RotationDegrees
$c* :: RotationDegrees -> RotationDegrees -> RotationDegrees
- :: RotationDegrees -> RotationDegrees -> RotationDegrees
$c- :: RotationDegrees -> RotationDegrees -> RotationDegrees
+ :: RotationDegrees -> RotationDegrees -> RotationDegrees
$c+ :: RotationDegrees -> RotationDegrees -> RotationDegrees
Num,Num RotationDegrees
Ord RotationDegrees
Num RotationDegrees
-> Ord RotationDegrees
-> (RotationDegrees -> Rational)
-> Real RotationDegrees
RotationDegrees -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: RotationDegrees -> Rational
$ctoRational :: RotationDegrees -> Rational
$cp2Real :: Ord RotationDegrees
$cp1Real :: Num RotationDegrees
Real,Num RotationDegrees
Num RotationDegrees
-> (RotationDegrees -> RotationDegrees -> RotationDegrees)
-> (RotationDegrees -> RotationDegrees)
-> (Rational -> RotationDegrees)
-> Fractional RotationDegrees
Rational -> RotationDegrees
RotationDegrees -> RotationDegrees
RotationDegrees -> RotationDegrees -> RotationDegrees
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> RotationDegrees
$cfromRational :: Rational -> RotationDegrees
recip :: RotationDegrees -> RotationDegrees
$crecip :: RotationDegrees -> RotationDegrees
/ :: RotationDegrees -> RotationDegrees -> RotationDegrees
$c/ :: RotationDegrees -> RotationDegrees -> RotationDegrees
$cp1Fractional :: Num RotationDegrees
Fractional,Fractional RotationDegrees
Real RotationDegrees
Real RotationDegrees
-> Fractional RotationDegrees
-> (forall b.
    Integral b =>
    RotationDegrees -> (b, RotationDegrees))
-> (forall b. Integral b => RotationDegrees -> b)
-> (forall b. Integral b => RotationDegrees -> b)
-> (forall b. Integral b => RotationDegrees -> b)
-> (forall b. Integral b => RotationDegrees -> b)
-> RealFrac RotationDegrees
RotationDegrees -> b
RotationDegrees -> b
RotationDegrees -> b
RotationDegrees -> b
RotationDegrees -> (b, RotationDegrees)
forall b. Integral b => RotationDegrees -> b
forall b. Integral b => RotationDegrees -> (b, RotationDegrees)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: RotationDegrees -> b
$cfloor :: forall b. Integral b => RotationDegrees -> b
ceiling :: RotationDegrees -> b
$cceiling :: forall b. Integral b => RotationDegrees -> b
round :: RotationDegrees -> b
$cround :: forall b. Integral b => RotationDegrees -> b
truncate :: RotationDegrees -> b
$ctruncate :: forall b. Integral b => RotationDegrees -> b
properFraction :: RotationDegrees -> (b, RotationDegrees)
$cproperFraction :: forall b. Integral b => RotationDegrees -> (b, RotationDegrees)
$cp2RealFrac :: Fractional RotationDegrees
$cp1RealFrac :: Real RotationDegrees
RealFrac)
instance Show RotationDegrees where show :: RotationDegrees -> String
show (RotationDegrees Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read RotationDegrees where readsPrec :: Int -> ReadS RotationDegrees
readsPrec Int
i = ((Decimal, String) -> (RotationDegrees, String))
-> [(Decimal, String)] -> [(RotationDegrees, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> RotationDegrees)
-> (Decimal, String) -> (RotationDegrees, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> RotationDegrees
RotationDegrees) ([(Decimal, String)] -> [(RotationDegrees, String)])
-> (String -> [(Decimal, String)]) -> ReadS RotationDegrees
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml RotationDegrees where
    emitXml :: RotationDegrees -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (RotationDegrees -> Decimal) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RotationDegrees -> Decimal
rotationDegrees
parseRotationDegrees :: String -> P.XParse RotationDegrees
parseRotationDegrees :: String -> XParse RotationDegrees
parseRotationDegrees = String -> String -> XParse RotationDegrees
forall a. Read a => String -> String -> XParse a
P.xread String
"RotationDegrees"

-- | @semi-pitched@ /(simple)/
--
-- The semi-pitched type represents categories of indefinite pitch for percussion instruments.
data SemiPitched = 
      SemiPitchedHigh -- ^ /high/
    | SemiPitchedMediumHigh -- ^ /medium-high/
    | SemiPitchedMedium -- ^ /medium/
    | SemiPitchedMediumLow -- ^ /medium-low/
    | SemiPitchedLow -- ^ /low/
    | SemiPitchedVeryLow -- ^ /very-low/
    deriving (SemiPitched -> SemiPitched -> Bool
(SemiPitched -> SemiPitched -> Bool)
-> (SemiPitched -> SemiPitched -> Bool) -> Eq SemiPitched
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SemiPitched -> SemiPitched -> Bool
$c/= :: SemiPitched -> SemiPitched -> Bool
== :: SemiPitched -> SemiPitched -> Bool
$c== :: SemiPitched -> SemiPitched -> Bool
Eq,Typeable,(forall x. SemiPitched -> Rep SemiPitched x)
-> (forall x. Rep SemiPitched x -> SemiPitched)
-> Generic SemiPitched
forall x. Rep SemiPitched x -> SemiPitched
forall x. SemiPitched -> Rep SemiPitched x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SemiPitched x -> SemiPitched
$cfrom :: forall x. SemiPitched -> Rep SemiPitched x
Generic,Int -> SemiPitched -> ShowS
[SemiPitched] -> ShowS
SemiPitched -> String
(Int -> SemiPitched -> ShowS)
-> (SemiPitched -> String)
-> ([SemiPitched] -> ShowS)
-> Show SemiPitched
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SemiPitched] -> ShowS
$cshowList :: [SemiPitched] -> ShowS
show :: SemiPitched -> String
$cshow :: SemiPitched -> String
showsPrec :: Int -> SemiPitched -> ShowS
$cshowsPrec :: Int -> SemiPitched -> ShowS
Show,Eq SemiPitched
Eq SemiPitched
-> (SemiPitched -> SemiPitched -> Ordering)
-> (SemiPitched -> SemiPitched -> Bool)
-> (SemiPitched -> SemiPitched -> Bool)
-> (SemiPitched -> SemiPitched -> Bool)
-> (SemiPitched -> SemiPitched -> Bool)
-> (SemiPitched -> SemiPitched -> SemiPitched)
-> (SemiPitched -> SemiPitched -> SemiPitched)
-> Ord SemiPitched
SemiPitched -> SemiPitched -> Bool
SemiPitched -> SemiPitched -> Ordering
SemiPitched -> SemiPitched -> SemiPitched
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SemiPitched -> SemiPitched -> SemiPitched
$cmin :: SemiPitched -> SemiPitched -> SemiPitched
max :: SemiPitched -> SemiPitched -> SemiPitched
$cmax :: SemiPitched -> SemiPitched -> SemiPitched
>= :: SemiPitched -> SemiPitched -> Bool
$c>= :: SemiPitched -> SemiPitched -> Bool
> :: SemiPitched -> SemiPitched -> Bool
$c> :: SemiPitched -> SemiPitched -> Bool
<= :: SemiPitched -> SemiPitched -> Bool
$c<= :: SemiPitched -> SemiPitched -> Bool
< :: SemiPitched -> SemiPitched -> Bool
$c< :: SemiPitched -> SemiPitched -> Bool
compare :: SemiPitched -> SemiPitched -> Ordering
$ccompare :: SemiPitched -> SemiPitched -> Ordering
$cp1Ord :: Eq SemiPitched
Ord,Int -> SemiPitched
SemiPitched -> Int
SemiPitched -> [SemiPitched]
SemiPitched -> SemiPitched
SemiPitched -> SemiPitched -> [SemiPitched]
SemiPitched -> SemiPitched -> SemiPitched -> [SemiPitched]
(SemiPitched -> SemiPitched)
-> (SemiPitched -> SemiPitched)
-> (Int -> SemiPitched)
-> (SemiPitched -> Int)
-> (SemiPitched -> [SemiPitched])
-> (SemiPitched -> SemiPitched -> [SemiPitched])
-> (SemiPitched -> SemiPitched -> [SemiPitched])
-> (SemiPitched -> SemiPitched -> SemiPitched -> [SemiPitched])
-> Enum SemiPitched
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SemiPitched -> SemiPitched -> SemiPitched -> [SemiPitched]
$cenumFromThenTo :: SemiPitched -> SemiPitched -> SemiPitched -> [SemiPitched]
enumFromTo :: SemiPitched -> SemiPitched -> [SemiPitched]
$cenumFromTo :: SemiPitched -> SemiPitched -> [SemiPitched]
enumFromThen :: SemiPitched -> SemiPitched -> [SemiPitched]
$cenumFromThen :: SemiPitched -> SemiPitched -> [SemiPitched]
enumFrom :: SemiPitched -> [SemiPitched]
$cenumFrom :: SemiPitched -> [SemiPitched]
fromEnum :: SemiPitched -> Int
$cfromEnum :: SemiPitched -> Int
toEnum :: Int -> SemiPitched
$ctoEnum :: Int -> SemiPitched
pred :: SemiPitched -> SemiPitched
$cpred :: SemiPitched -> SemiPitched
succ :: SemiPitched -> SemiPitched
$csucc :: SemiPitched -> SemiPitched
Enum,SemiPitched
SemiPitched -> SemiPitched -> Bounded SemiPitched
forall a. a -> a -> Bounded a
maxBound :: SemiPitched
$cmaxBound :: SemiPitched
minBound :: SemiPitched
$cminBound :: SemiPitched
Bounded)
instance EmitXml SemiPitched where
    emitXml :: SemiPitched -> XmlRep
emitXml SemiPitched
SemiPitchedHigh = String -> XmlRep
XLit String
"high"
    emitXml SemiPitched
SemiPitchedMediumHigh = String -> XmlRep
XLit String
"medium-high"
    emitXml SemiPitched
SemiPitchedMedium = String -> XmlRep
XLit String
"medium"
    emitXml SemiPitched
SemiPitchedMediumLow = String -> XmlRep
XLit String
"medium-low"
    emitXml SemiPitched
SemiPitchedLow = String -> XmlRep
XLit String
"low"
    emitXml SemiPitched
SemiPitchedVeryLow = String -> XmlRep
XLit String
"very-low"
parseSemiPitched :: String -> P.XParse SemiPitched
parseSemiPitched :: String -> XParse SemiPitched
parseSemiPitched String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"high" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedHigh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium-high" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedMediumHigh
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedMedium
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium-low" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedMediumLow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"low" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedLow
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"very-low" = SemiPitched -> XParse SemiPitched
forall (m :: * -> *) a. Monad m => a -> m a
return (SemiPitched -> XParse SemiPitched)
-> SemiPitched -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ SemiPitched
SemiPitchedVeryLow
        | Bool
otherwise = String -> XParse SemiPitched
forall a. String -> XParse a
P.xfail (String -> XParse SemiPitched) -> String -> XParse SemiPitched
forall a b. (a -> b) -> a -> b
$ String
"SemiPitched: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @semitones@ /(simple)/
--
-- The semitones type is a number representing semitones, used for chromatic alteration. A value of -1 corresponds to a flat and a value of 1 to a sharp. Decimal values like 0.5 (quarter tone sharp) are used for microtones.
newtype Semitones = Semitones { Semitones -> Decimal
semitones :: Decimal }
    deriving (Semitones -> Semitones -> Bool
(Semitones -> Semitones -> Bool)
-> (Semitones -> Semitones -> Bool) -> Eq Semitones
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Semitones -> Semitones -> Bool
$c/= :: Semitones -> Semitones -> Bool
== :: Semitones -> Semitones -> Bool
$c== :: Semitones -> Semitones -> Bool
Eq,Typeable,(forall x. Semitones -> Rep Semitones x)
-> (forall x. Rep Semitones x -> Semitones) -> Generic Semitones
forall x. Rep Semitones x -> Semitones
forall x. Semitones -> Rep Semitones x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Semitones x -> Semitones
$cfrom :: forall x. Semitones -> Rep Semitones x
Generic,Eq Semitones
Eq Semitones
-> (Semitones -> Semitones -> Ordering)
-> (Semitones -> Semitones -> Bool)
-> (Semitones -> Semitones -> Bool)
-> (Semitones -> Semitones -> Bool)
-> (Semitones -> Semitones -> Bool)
-> (Semitones -> Semitones -> Semitones)
-> (Semitones -> Semitones -> Semitones)
-> Ord Semitones
Semitones -> Semitones -> Bool
Semitones -> Semitones -> Ordering
Semitones -> Semitones -> Semitones
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Semitones -> Semitones -> Semitones
$cmin :: Semitones -> Semitones -> Semitones
max :: Semitones -> Semitones -> Semitones
$cmax :: Semitones -> Semitones -> Semitones
>= :: Semitones -> Semitones -> Bool
$c>= :: Semitones -> Semitones -> Bool
> :: Semitones -> Semitones -> Bool
$c> :: Semitones -> Semitones -> Bool
<= :: Semitones -> Semitones -> Bool
$c<= :: Semitones -> Semitones -> Bool
< :: Semitones -> Semitones -> Bool
$c< :: Semitones -> Semitones -> Bool
compare :: Semitones -> Semitones -> Ordering
$ccompare :: Semitones -> Semitones -> Ordering
$cp1Ord :: Eq Semitones
Ord,Integer -> Semitones
Semitones -> Semitones
Semitones -> Semitones -> Semitones
(Semitones -> Semitones -> Semitones)
-> (Semitones -> Semitones -> Semitones)
-> (Semitones -> Semitones -> Semitones)
-> (Semitones -> Semitones)
-> (Semitones -> Semitones)
-> (Semitones -> Semitones)
-> (Integer -> Semitones)
-> Num Semitones
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Semitones
$cfromInteger :: Integer -> Semitones
signum :: Semitones -> Semitones
$csignum :: Semitones -> Semitones
abs :: Semitones -> Semitones
$cabs :: Semitones -> Semitones
negate :: Semitones -> Semitones
$cnegate :: Semitones -> Semitones
* :: Semitones -> Semitones -> Semitones
$c* :: Semitones -> Semitones -> Semitones
- :: Semitones -> Semitones -> Semitones
$c- :: Semitones -> Semitones -> Semitones
+ :: Semitones -> Semitones -> Semitones
$c+ :: Semitones -> Semitones -> Semitones
Num,Num Semitones
Ord Semitones
Num Semitones
-> Ord Semitones -> (Semitones -> Rational) -> Real Semitones
Semitones -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Semitones -> Rational
$ctoRational :: Semitones -> Rational
$cp2Real :: Ord Semitones
$cp1Real :: Num Semitones
Real,Num Semitones
Num Semitones
-> (Semitones -> Semitones -> Semitones)
-> (Semitones -> Semitones)
-> (Rational -> Semitones)
-> Fractional Semitones
Rational -> Semitones
Semitones -> Semitones
Semitones -> Semitones -> Semitones
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Semitones
$cfromRational :: Rational -> Semitones
recip :: Semitones -> Semitones
$crecip :: Semitones -> Semitones
/ :: Semitones -> Semitones -> Semitones
$c/ :: Semitones -> Semitones -> Semitones
$cp1Fractional :: Num Semitones
Fractional,Fractional Semitones
Real Semitones
Real Semitones
-> Fractional Semitones
-> (forall b. Integral b => Semitones -> (b, Semitones))
-> (forall b. Integral b => Semitones -> b)
-> (forall b. Integral b => Semitones -> b)
-> (forall b. Integral b => Semitones -> b)
-> (forall b. Integral b => Semitones -> b)
-> RealFrac Semitones
Semitones -> b
Semitones -> b
Semitones -> b
Semitones -> b
Semitones -> (b, Semitones)
forall b. Integral b => Semitones -> b
forall b. Integral b => Semitones -> (b, Semitones)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Semitones -> b
$cfloor :: forall b. Integral b => Semitones -> b
ceiling :: Semitones -> b
$cceiling :: forall b. Integral b => Semitones -> b
round :: Semitones -> b
$cround :: forall b. Integral b => Semitones -> b
truncate :: Semitones -> b
$ctruncate :: forall b. Integral b => Semitones -> b
properFraction :: Semitones -> (b, Semitones)
$cproperFraction :: forall b. Integral b => Semitones -> (b, Semitones)
$cp2RealFrac :: Fractional Semitones
$cp1RealFrac :: Real Semitones
RealFrac)
instance Show Semitones where show :: Semitones -> String
show (Semitones Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read Semitones where readsPrec :: Int -> ReadS Semitones
readsPrec Int
i = ((Decimal, String) -> (Semitones, String))
-> [(Decimal, String)] -> [(Semitones, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> Semitones) -> (Decimal, String) -> (Semitones, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> Semitones
Semitones) ([(Decimal, String)] -> [(Semitones, String)])
-> (String -> [(Decimal, String)]) -> ReadS Semitones
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Semitones where
    emitXml :: Semitones -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (Semitones -> Decimal) -> Semitones -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Semitones -> Decimal
semitones
parseSemitones :: String -> P.XParse Semitones
parseSemitones :: String -> XParse Semitones
parseSemitones = String -> String -> XParse Semitones
forall a. Read a => String -> String -> XParse a
P.xread String
"Semitones"

-- | @xlink:show@ /(simple)/
data SmpShow = 
      ShowNew -- ^ /new/
    | ShowReplace -- ^ /replace/
    | ShowEmbed -- ^ /embed/
    | ShowOther -- ^ /other/
    | ShowNone -- ^ /none/
    deriving (SmpShow -> SmpShow -> Bool
(SmpShow -> SmpShow -> Bool)
-> (SmpShow -> SmpShow -> Bool) -> Eq SmpShow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmpShow -> SmpShow -> Bool
$c/= :: SmpShow -> SmpShow -> Bool
== :: SmpShow -> SmpShow -> Bool
$c== :: SmpShow -> SmpShow -> Bool
Eq,Typeable,(forall x. SmpShow -> Rep SmpShow x)
-> (forall x. Rep SmpShow x -> SmpShow) -> Generic SmpShow
forall x. Rep SmpShow x -> SmpShow
forall x. SmpShow -> Rep SmpShow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmpShow x -> SmpShow
$cfrom :: forall x. SmpShow -> Rep SmpShow x
Generic,Int -> SmpShow -> ShowS
[SmpShow] -> ShowS
SmpShow -> String
(Int -> SmpShow -> ShowS)
-> (SmpShow -> String) -> ([SmpShow] -> ShowS) -> Show SmpShow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmpShow] -> ShowS
$cshowList :: [SmpShow] -> ShowS
show :: SmpShow -> String
$cshow :: SmpShow -> String
showsPrec :: Int -> SmpShow -> ShowS
$cshowsPrec :: Int -> SmpShow -> ShowS
Show,Eq SmpShow
Eq SmpShow
-> (SmpShow -> SmpShow -> Ordering)
-> (SmpShow -> SmpShow -> Bool)
-> (SmpShow -> SmpShow -> Bool)
-> (SmpShow -> SmpShow -> Bool)
-> (SmpShow -> SmpShow -> Bool)
-> (SmpShow -> SmpShow -> SmpShow)
-> (SmpShow -> SmpShow -> SmpShow)
-> Ord SmpShow
SmpShow -> SmpShow -> Bool
SmpShow -> SmpShow -> Ordering
SmpShow -> SmpShow -> SmpShow
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmpShow -> SmpShow -> SmpShow
$cmin :: SmpShow -> SmpShow -> SmpShow
max :: SmpShow -> SmpShow -> SmpShow
$cmax :: SmpShow -> SmpShow -> SmpShow
>= :: SmpShow -> SmpShow -> Bool
$c>= :: SmpShow -> SmpShow -> Bool
> :: SmpShow -> SmpShow -> Bool
$c> :: SmpShow -> SmpShow -> Bool
<= :: SmpShow -> SmpShow -> Bool
$c<= :: SmpShow -> SmpShow -> Bool
< :: SmpShow -> SmpShow -> Bool
$c< :: SmpShow -> SmpShow -> Bool
compare :: SmpShow -> SmpShow -> Ordering
$ccompare :: SmpShow -> SmpShow -> Ordering
$cp1Ord :: Eq SmpShow
Ord,Int -> SmpShow
SmpShow -> Int
SmpShow -> [SmpShow]
SmpShow -> SmpShow
SmpShow -> SmpShow -> [SmpShow]
SmpShow -> SmpShow -> SmpShow -> [SmpShow]
(SmpShow -> SmpShow)
-> (SmpShow -> SmpShow)
-> (Int -> SmpShow)
-> (SmpShow -> Int)
-> (SmpShow -> [SmpShow])
-> (SmpShow -> SmpShow -> [SmpShow])
-> (SmpShow -> SmpShow -> [SmpShow])
-> (SmpShow -> SmpShow -> SmpShow -> [SmpShow])
-> Enum SmpShow
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmpShow -> SmpShow -> SmpShow -> [SmpShow]
$cenumFromThenTo :: SmpShow -> SmpShow -> SmpShow -> [SmpShow]
enumFromTo :: SmpShow -> SmpShow -> [SmpShow]
$cenumFromTo :: SmpShow -> SmpShow -> [SmpShow]
enumFromThen :: SmpShow -> SmpShow -> [SmpShow]
$cenumFromThen :: SmpShow -> SmpShow -> [SmpShow]
enumFrom :: SmpShow -> [SmpShow]
$cenumFrom :: SmpShow -> [SmpShow]
fromEnum :: SmpShow -> Int
$cfromEnum :: SmpShow -> Int
toEnum :: Int -> SmpShow
$ctoEnum :: Int -> SmpShow
pred :: SmpShow -> SmpShow
$cpred :: SmpShow -> SmpShow
succ :: SmpShow -> SmpShow
$csucc :: SmpShow -> SmpShow
Enum,SmpShow
SmpShow -> SmpShow -> Bounded SmpShow
forall a. a -> a -> Bounded a
maxBound :: SmpShow
$cmaxBound :: SmpShow
minBound :: SmpShow
$cminBound :: SmpShow
Bounded)
instance EmitXml SmpShow where
    emitXml :: SmpShow -> XmlRep
emitXml SmpShow
ShowNew = String -> XmlRep
XLit String
"new"
    emitXml SmpShow
ShowReplace = String -> XmlRep
XLit String
"replace"
    emitXml SmpShow
ShowEmbed = String -> XmlRep
XLit String
"embed"
    emitXml SmpShow
ShowOther = String -> XmlRep
XLit String
"other"
    emitXml SmpShow
ShowNone = String -> XmlRep
XLit String
"none"
parseSmpShow :: String -> P.XParse SmpShow
parseSmpShow :: String -> XParse SmpShow
parseSmpShow String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"new" = SmpShow -> XParse SmpShow
forall (m :: * -> *) a. Monad m => a -> m a
return (SmpShow -> XParse SmpShow) -> SmpShow -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ SmpShow
ShowNew
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"replace" = SmpShow -> XParse SmpShow
forall (m :: * -> *) a. Monad m => a -> m a
return (SmpShow -> XParse SmpShow) -> SmpShow -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ SmpShow
ShowReplace
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"embed" = SmpShow -> XParse SmpShow
forall (m :: * -> *) a. Monad m => a -> m a
return (SmpShow -> XParse SmpShow) -> SmpShow -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ SmpShow
ShowEmbed
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"other" = SmpShow -> XParse SmpShow
forall (m :: * -> *) a. Monad m => a -> m a
return (SmpShow -> XParse SmpShow) -> SmpShow -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ SmpShow
ShowOther
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = SmpShow -> XParse SmpShow
forall (m :: * -> *) a. Monad m => a -> m a
return (SmpShow -> XParse SmpShow) -> SmpShow -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ SmpShow
ShowNone
        | Bool
otherwise = String -> XParse SmpShow
forall a. String -> XParse a
P.xfail (String -> XParse SmpShow) -> String -> XParse SmpShow
forall a b. (a -> b) -> a -> b
$ String
"SmpShow: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @show-frets@ /(simple)/
--
-- The show-frets type indicates whether to show tablature frets as numbers (0, 1, 2) or letters (a, b, c). The default choice is numbers.
data ShowFrets = 
      ShowFretsNumbers -- ^ /numbers/
    | ShowFretsLetters -- ^ /letters/
    deriving (ShowFrets -> ShowFrets -> Bool
(ShowFrets -> ShowFrets -> Bool)
-> (ShowFrets -> ShowFrets -> Bool) -> Eq ShowFrets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowFrets -> ShowFrets -> Bool
$c/= :: ShowFrets -> ShowFrets -> Bool
== :: ShowFrets -> ShowFrets -> Bool
$c== :: ShowFrets -> ShowFrets -> Bool
Eq,Typeable,(forall x. ShowFrets -> Rep ShowFrets x)
-> (forall x. Rep ShowFrets x -> ShowFrets) -> Generic ShowFrets
forall x. Rep ShowFrets x -> ShowFrets
forall x. ShowFrets -> Rep ShowFrets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShowFrets x -> ShowFrets
$cfrom :: forall x. ShowFrets -> Rep ShowFrets x
Generic,Int -> ShowFrets -> ShowS
[ShowFrets] -> ShowS
ShowFrets -> String
(Int -> ShowFrets -> ShowS)
-> (ShowFrets -> String)
-> ([ShowFrets] -> ShowS)
-> Show ShowFrets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowFrets] -> ShowS
$cshowList :: [ShowFrets] -> ShowS
show :: ShowFrets -> String
$cshow :: ShowFrets -> String
showsPrec :: Int -> ShowFrets -> ShowS
$cshowsPrec :: Int -> ShowFrets -> ShowS
Show,Eq ShowFrets
Eq ShowFrets
-> (ShowFrets -> ShowFrets -> Ordering)
-> (ShowFrets -> ShowFrets -> Bool)
-> (ShowFrets -> ShowFrets -> Bool)
-> (ShowFrets -> ShowFrets -> Bool)
-> (ShowFrets -> ShowFrets -> Bool)
-> (ShowFrets -> ShowFrets -> ShowFrets)
-> (ShowFrets -> ShowFrets -> ShowFrets)
-> Ord ShowFrets
ShowFrets -> ShowFrets -> Bool
ShowFrets -> ShowFrets -> Ordering
ShowFrets -> ShowFrets -> ShowFrets
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShowFrets -> ShowFrets -> ShowFrets
$cmin :: ShowFrets -> ShowFrets -> ShowFrets
max :: ShowFrets -> ShowFrets -> ShowFrets
$cmax :: ShowFrets -> ShowFrets -> ShowFrets
>= :: ShowFrets -> ShowFrets -> Bool
$c>= :: ShowFrets -> ShowFrets -> Bool
> :: ShowFrets -> ShowFrets -> Bool
$c> :: ShowFrets -> ShowFrets -> Bool
<= :: ShowFrets -> ShowFrets -> Bool
$c<= :: ShowFrets -> ShowFrets -> Bool
< :: ShowFrets -> ShowFrets -> Bool
$c< :: ShowFrets -> ShowFrets -> Bool
compare :: ShowFrets -> ShowFrets -> Ordering
$ccompare :: ShowFrets -> ShowFrets -> Ordering
$cp1Ord :: Eq ShowFrets
Ord,Int -> ShowFrets
ShowFrets -> Int
ShowFrets -> [ShowFrets]
ShowFrets -> ShowFrets
ShowFrets -> ShowFrets -> [ShowFrets]
ShowFrets -> ShowFrets -> ShowFrets -> [ShowFrets]
(ShowFrets -> ShowFrets)
-> (ShowFrets -> ShowFrets)
-> (Int -> ShowFrets)
-> (ShowFrets -> Int)
-> (ShowFrets -> [ShowFrets])
-> (ShowFrets -> ShowFrets -> [ShowFrets])
-> (ShowFrets -> ShowFrets -> [ShowFrets])
-> (ShowFrets -> ShowFrets -> ShowFrets -> [ShowFrets])
-> Enum ShowFrets
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShowFrets -> ShowFrets -> ShowFrets -> [ShowFrets]
$cenumFromThenTo :: ShowFrets -> ShowFrets -> ShowFrets -> [ShowFrets]
enumFromTo :: ShowFrets -> ShowFrets -> [ShowFrets]
$cenumFromTo :: ShowFrets -> ShowFrets -> [ShowFrets]
enumFromThen :: ShowFrets -> ShowFrets -> [ShowFrets]
$cenumFromThen :: ShowFrets -> ShowFrets -> [ShowFrets]
enumFrom :: ShowFrets -> [ShowFrets]
$cenumFrom :: ShowFrets -> [ShowFrets]
fromEnum :: ShowFrets -> Int
$cfromEnum :: ShowFrets -> Int
toEnum :: Int -> ShowFrets
$ctoEnum :: Int -> ShowFrets
pred :: ShowFrets -> ShowFrets
$cpred :: ShowFrets -> ShowFrets
succ :: ShowFrets -> ShowFrets
$csucc :: ShowFrets -> ShowFrets
Enum,ShowFrets
ShowFrets -> ShowFrets -> Bounded ShowFrets
forall a. a -> a -> Bounded a
maxBound :: ShowFrets
$cmaxBound :: ShowFrets
minBound :: ShowFrets
$cminBound :: ShowFrets
Bounded)
instance EmitXml ShowFrets where
    emitXml :: ShowFrets -> XmlRep
emitXml ShowFrets
ShowFretsNumbers = String -> XmlRep
XLit String
"numbers"
    emitXml ShowFrets
ShowFretsLetters = String -> XmlRep
XLit String
"letters"
parseShowFrets :: String -> P.XParse ShowFrets
parseShowFrets :: String -> XParse ShowFrets
parseShowFrets String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"numbers" = ShowFrets -> XParse ShowFrets
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowFrets -> XParse ShowFrets) -> ShowFrets -> XParse ShowFrets
forall a b. (a -> b) -> a -> b
$ ShowFrets
ShowFretsNumbers
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"letters" = ShowFrets -> XParse ShowFrets
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowFrets -> XParse ShowFrets) -> ShowFrets -> XParse ShowFrets
forall a b. (a -> b) -> a -> b
$ ShowFrets
ShowFretsLetters
        | Bool
otherwise = String -> XParse ShowFrets
forall a. String -> XParse a
P.xfail (String -> XParse ShowFrets) -> String -> XParse ShowFrets
forall a b. (a -> b) -> a -> b
$ String
"ShowFrets: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @show-tuplet@ /(simple)/
--
-- The show-tuplet type indicates whether to show a part of a tuplet relating to the tuplet-actual element, both the tuplet-actual and tuplet-normal elements, or neither.
data ShowTuplet = 
      ShowTupletActual -- ^ /actual/
    | ShowTupletBoth -- ^ /both/
    | ShowTupletNone -- ^ /none/
    deriving (ShowTuplet -> ShowTuplet -> Bool
(ShowTuplet -> ShowTuplet -> Bool)
-> (ShowTuplet -> ShowTuplet -> Bool) -> Eq ShowTuplet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowTuplet -> ShowTuplet -> Bool
$c/= :: ShowTuplet -> ShowTuplet -> Bool
== :: ShowTuplet -> ShowTuplet -> Bool
$c== :: ShowTuplet -> ShowTuplet -> Bool
Eq,Typeable,(forall x. ShowTuplet -> Rep ShowTuplet x)
-> (forall x. Rep ShowTuplet x -> ShowTuplet) -> Generic ShowTuplet
forall x. Rep ShowTuplet x -> ShowTuplet
forall x. ShowTuplet -> Rep ShowTuplet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShowTuplet x -> ShowTuplet
$cfrom :: forall x. ShowTuplet -> Rep ShowTuplet x
Generic,Int -> ShowTuplet -> ShowS
[ShowTuplet] -> ShowS
ShowTuplet -> String
(Int -> ShowTuplet -> ShowS)
-> (ShowTuplet -> String)
-> ([ShowTuplet] -> ShowS)
-> Show ShowTuplet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowTuplet] -> ShowS
$cshowList :: [ShowTuplet] -> ShowS
show :: ShowTuplet -> String
$cshow :: ShowTuplet -> String
showsPrec :: Int -> ShowTuplet -> ShowS
$cshowsPrec :: Int -> ShowTuplet -> ShowS
Show,Eq ShowTuplet
Eq ShowTuplet
-> (ShowTuplet -> ShowTuplet -> Ordering)
-> (ShowTuplet -> ShowTuplet -> Bool)
-> (ShowTuplet -> ShowTuplet -> Bool)
-> (ShowTuplet -> ShowTuplet -> Bool)
-> (ShowTuplet -> ShowTuplet -> Bool)
-> (ShowTuplet -> ShowTuplet -> ShowTuplet)
-> (ShowTuplet -> ShowTuplet -> ShowTuplet)
-> Ord ShowTuplet
ShowTuplet -> ShowTuplet -> Bool
ShowTuplet -> ShowTuplet -> Ordering
ShowTuplet -> ShowTuplet -> ShowTuplet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShowTuplet -> ShowTuplet -> ShowTuplet
$cmin :: ShowTuplet -> ShowTuplet -> ShowTuplet
max :: ShowTuplet -> ShowTuplet -> ShowTuplet
$cmax :: ShowTuplet -> ShowTuplet -> ShowTuplet
>= :: ShowTuplet -> ShowTuplet -> Bool
$c>= :: ShowTuplet -> ShowTuplet -> Bool
> :: ShowTuplet -> ShowTuplet -> Bool
$c> :: ShowTuplet -> ShowTuplet -> Bool
<= :: ShowTuplet -> ShowTuplet -> Bool
$c<= :: ShowTuplet -> ShowTuplet -> Bool
< :: ShowTuplet -> ShowTuplet -> Bool
$c< :: ShowTuplet -> ShowTuplet -> Bool
compare :: ShowTuplet -> ShowTuplet -> Ordering
$ccompare :: ShowTuplet -> ShowTuplet -> Ordering
$cp1Ord :: Eq ShowTuplet
Ord,Int -> ShowTuplet
ShowTuplet -> Int
ShowTuplet -> [ShowTuplet]
ShowTuplet -> ShowTuplet
ShowTuplet -> ShowTuplet -> [ShowTuplet]
ShowTuplet -> ShowTuplet -> ShowTuplet -> [ShowTuplet]
(ShowTuplet -> ShowTuplet)
-> (ShowTuplet -> ShowTuplet)
-> (Int -> ShowTuplet)
-> (ShowTuplet -> Int)
-> (ShowTuplet -> [ShowTuplet])
-> (ShowTuplet -> ShowTuplet -> [ShowTuplet])
-> (ShowTuplet -> ShowTuplet -> [ShowTuplet])
-> (ShowTuplet -> ShowTuplet -> ShowTuplet -> [ShowTuplet])
-> Enum ShowTuplet
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ShowTuplet -> ShowTuplet -> ShowTuplet -> [ShowTuplet]
$cenumFromThenTo :: ShowTuplet -> ShowTuplet -> ShowTuplet -> [ShowTuplet]
enumFromTo :: ShowTuplet -> ShowTuplet -> [ShowTuplet]
$cenumFromTo :: ShowTuplet -> ShowTuplet -> [ShowTuplet]
enumFromThen :: ShowTuplet -> ShowTuplet -> [ShowTuplet]
$cenumFromThen :: ShowTuplet -> ShowTuplet -> [ShowTuplet]
enumFrom :: ShowTuplet -> [ShowTuplet]
$cenumFrom :: ShowTuplet -> [ShowTuplet]
fromEnum :: ShowTuplet -> Int
$cfromEnum :: ShowTuplet -> Int
toEnum :: Int -> ShowTuplet
$ctoEnum :: Int -> ShowTuplet
pred :: ShowTuplet -> ShowTuplet
$cpred :: ShowTuplet -> ShowTuplet
succ :: ShowTuplet -> ShowTuplet
$csucc :: ShowTuplet -> ShowTuplet
Enum,ShowTuplet
ShowTuplet -> ShowTuplet -> Bounded ShowTuplet
forall a. a -> a -> Bounded a
maxBound :: ShowTuplet
$cmaxBound :: ShowTuplet
minBound :: ShowTuplet
$cminBound :: ShowTuplet
Bounded)
instance EmitXml ShowTuplet where
    emitXml :: ShowTuplet -> XmlRep
emitXml ShowTuplet
ShowTupletActual = String -> XmlRep
XLit String
"actual"
    emitXml ShowTuplet
ShowTupletBoth = String -> XmlRep
XLit String
"both"
    emitXml ShowTuplet
ShowTupletNone = String -> XmlRep
XLit String
"none"
parseShowTuplet :: String -> P.XParse ShowTuplet
parseShowTuplet :: String -> XParse ShowTuplet
parseShowTuplet String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"actual" = ShowTuplet -> XParse ShowTuplet
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowTuplet -> XParse ShowTuplet)
-> ShowTuplet -> XParse ShowTuplet
forall a b. (a -> b) -> a -> b
$ ShowTuplet
ShowTupletActual
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"both" = ShowTuplet -> XParse ShowTuplet
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowTuplet -> XParse ShowTuplet)
-> ShowTuplet -> XParse ShowTuplet
forall a b. (a -> b) -> a -> b
$ ShowTuplet
ShowTupletBoth
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = ShowTuplet -> XParse ShowTuplet
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowTuplet -> XParse ShowTuplet)
-> ShowTuplet -> XParse ShowTuplet
forall a b. (a -> b) -> a -> b
$ ShowTuplet
ShowTupletNone
        | Bool
otherwise = String -> XParse ShowTuplet
forall a. String -> XParse a
P.xfail (String -> XParse ShowTuplet) -> String -> XParse ShowTuplet
forall a b. (a -> b) -> a -> b
$ String
"ShowTuplet: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @smufl-accidental-glyph-name@ /(simple)/
--
-- The smufl-accidental-glyph-name type is used to reference a specific Standard Music Font Layout (SMuFL) accidental character. The value is a SMuFL canonical glyph name that starts with acc.
newtype SmuflAccidentalGlyphName = SmuflAccidentalGlyphName { SmuflAccidentalGlyphName -> SmuflGlyphName
smuflAccidentalGlyphName :: SmuflGlyphName }
    deriving (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
(SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> Eq SmuflAccidentalGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c/= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
== :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c== :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
Eq,Typeable,(forall x.
 SmuflAccidentalGlyphName -> Rep SmuflAccidentalGlyphName x)
-> (forall x.
    Rep SmuflAccidentalGlyphName x -> SmuflAccidentalGlyphName)
-> Generic SmuflAccidentalGlyphName
forall x.
Rep SmuflAccidentalGlyphName x -> SmuflAccidentalGlyphName
forall x.
SmuflAccidentalGlyphName -> Rep SmuflAccidentalGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SmuflAccidentalGlyphName x -> SmuflAccidentalGlyphName
$cfrom :: forall x.
SmuflAccidentalGlyphName -> Rep SmuflAccidentalGlyphName x
Generic,Eq SmuflAccidentalGlyphName
Eq SmuflAccidentalGlyphName
-> (SmuflAccidentalGlyphName
    -> SmuflAccidentalGlyphName -> Ordering)
-> (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> (SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool)
-> (SmuflAccidentalGlyphName
    -> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName)
-> (SmuflAccidentalGlyphName
    -> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName)
-> Ord SmuflAccidentalGlyphName
SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Ordering
SmuflAccidentalGlyphName
-> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflAccidentalGlyphName
-> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName
$cmin :: SmuflAccidentalGlyphName
-> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName
max :: SmuflAccidentalGlyphName
-> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName
$cmax :: SmuflAccidentalGlyphName
-> SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName
>= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c>= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
> :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c> :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
<= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c<= :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
< :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
$c< :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Bool
compare :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Ordering
$ccompare :: SmuflAccidentalGlyphName -> SmuflAccidentalGlyphName -> Ordering
$cp1Ord :: Eq SmuflAccidentalGlyphName
Ord,String -> SmuflAccidentalGlyphName
(String -> SmuflAccidentalGlyphName)
-> IsString SmuflAccidentalGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflAccidentalGlyphName
$cfromString :: String -> SmuflAccidentalGlyphName
IsString)
instance Show SmuflAccidentalGlyphName where show :: SmuflAccidentalGlyphName -> String
show (SmuflAccidentalGlyphName SmuflGlyphName
a) = SmuflGlyphName -> String
forall a. Show a => a -> String
show SmuflGlyphName
a
instance Read SmuflAccidentalGlyphName where readsPrec :: Int -> ReadS SmuflAccidentalGlyphName
readsPrec Int
i = ((SmuflGlyphName, String) -> (SmuflAccidentalGlyphName, String))
-> [(SmuflGlyphName, String)]
-> [(SmuflAccidentalGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((SmuflGlyphName -> SmuflAccidentalGlyphName)
-> (SmuflGlyphName, String) -> (SmuflAccidentalGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first SmuflGlyphName -> SmuflAccidentalGlyphName
SmuflAccidentalGlyphName) ([(SmuflGlyphName, String)]
 -> [(SmuflAccidentalGlyphName, String)])
-> (String -> [(SmuflGlyphName, String)])
-> ReadS SmuflAccidentalGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(SmuflGlyphName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflAccidentalGlyphName where
    emitXml :: SmuflAccidentalGlyphName -> XmlRep
emitXml = SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (SmuflGlyphName -> XmlRep)
-> (SmuflAccidentalGlyphName -> SmuflGlyphName)
-> SmuflAccidentalGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflAccidentalGlyphName -> SmuflGlyphName
smuflAccidentalGlyphName
parseSmuflAccidentalGlyphName :: String -> P.XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName :: String -> XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName = SmuflAccidentalGlyphName -> XParse SmuflAccidentalGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflAccidentalGlyphName -> XParse SmuflAccidentalGlyphName)
-> (String -> SmuflAccidentalGlyphName)
-> String
-> XParse SmuflAccidentalGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflAccidentalGlyphName
forall a. IsString a => String -> a
fromString

-- | @smufl-coda-glyph-name@ /(simple)/
--
-- The smufl-coda-glyph-name type is used to reference a specific Standard Music Font Layout (SMuFL) coda character. The value is a SMuFL canonical glyph name that starts with coda.
newtype SmuflCodaGlyphName = SmuflCodaGlyphName { SmuflCodaGlyphName -> SmuflGlyphName
smuflCodaGlyphName :: SmuflGlyphName }
    deriving (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
(SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> Eq SmuflCodaGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c/= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
== :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c== :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
Eq,Typeable,(forall x. SmuflCodaGlyphName -> Rep SmuflCodaGlyphName x)
-> (forall x. Rep SmuflCodaGlyphName x -> SmuflCodaGlyphName)
-> Generic SmuflCodaGlyphName
forall x. Rep SmuflCodaGlyphName x -> SmuflCodaGlyphName
forall x. SmuflCodaGlyphName -> Rep SmuflCodaGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmuflCodaGlyphName x -> SmuflCodaGlyphName
$cfrom :: forall x. SmuflCodaGlyphName -> Rep SmuflCodaGlyphName x
Generic,Eq SmuflCodaGlyphName
Eq SmuflCodaGlyphName
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Ordering)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName)
-> (SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName)
-> Ord SmuflCodaGlyphName
SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
SmuflCodaGlyphName -> SmuflCodaGlyphName -> Ordering
SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName
$cmin :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName
max :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName
$cmax :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> SmuflCodaGlyphName
>= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c>= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
> :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c> :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
<= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c<= :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
< :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
$c< :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Bool
compare :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Ordering
$ccompare :: SmuflCodaGlyphName -> SmuflCodaGlyphName -> Ordering
$cp1Ord :: Eq SmuflCodaGlyphName
Ord,String -> SmuflCodaGlyphName
(String -> SmuflCodaGlyphName) -> IsString SmuflCodaGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflCodaGlyphName
$cfromString :: String -> SmuflCodaGlyphName
IsString)
instance Show SmuflCodaGlyphName where show :: SmuflCodaGlyphName -> String
show (SmuflCodaGlyphName SmuflGlyphName
a) = SmuflGlyphName -> String
forall a. Show a => a -> String
show SmuflGlyphName
a
instance Read SmuflCodaGlyphName where readsPrec :: Int -> ReadS SmuflCodaGlyphName
readsPrec Int
i = ((SmuflGlyphName, String) -> (SmuflCodaGlyphName, String))
-> [(SmuflGlyphName, String)] -> [(SmuflCodaGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((SmuflGlyphName -> SmuflCodaGlyphName)
-> (SmuflGlyphName, String) -> (SmuflCodaGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first SmuflGlyphName -> SmuflCodaGlyphName
SmuflCodaGlyphName) ([(SmuflGlyphName, String)] -> [(SmuflCodaGlyphName, String)])
-> (String -> [(SmuflGlyphName, String)])
-> ReadS SmuflCodaGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(SmuflGlyphName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflCodaGlyphName where
    emitXml :: SmuflCodaGlyphName -> XmlRep
emitXml = SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (SmuflGlyphName -> XmlRep)
-> (SmuflCodaGlyphName -> SmuflGlyphName)
-> SmuflCodaGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflCodaGlyphName -> SmuflGlyphName
smuflCodaGlyphName
parseSmuflCodaGlyphName :: String -> P.XParse SmuflCodaGlyphName
parseSmuflCodaGlyphName :: String -> XParse SmuflCodaGlyphName
parseSmuflCodaGlyphName = SmuflCodaGlyphName -> XParse SmuflCodaGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflCodaGlyphName -> XParse SmuflCodaGlyphName)
-> (String -> SmuflCodaGlyphName)
-> String
-> XParse SmuflCodaGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflCodaGlyphName
forall a. IsString a => String -> a
fromString

-- | @smufl-glyph-name@ /(simple)/
--
-- The smufl-glyph-name type is used for attributes that reference a specific Standard Music Font Layout (SMuFL) character. The value is a SMuFL canonical glyph name, not a code point. For instance, the value for a standard piano pedal mark would be keyboardPedalPed, not U+E650.
newtype SmuflGlyphName = SmuflGlyphName { SmuflGlyphName -> NMTOKEN
smuflGlyphName :: NMTOKEN }
    deriving (SmuflGlyphName -> SmuflGlyphName -> Bool
(SmuflGlyphName -> SmuflGlyphName -> Bool)
-> (SmuflGlyphName -> SmuflGlyphName -> Bool) -> Eq SmuflGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c/= :: SmuflGlyphName -> SmuflGlyphName -> Bool
== :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c== :: SmuflGlyphName -> SmuflGlyphName -> Bool
Eq,Typeable,(forall x. SmuflGlyphName -> Rep SmuflGlyphName x)
-> (forall x. Rep SmuflGlyphName x -> SmuflGlyphName)
-> Generic SmuflGlyphName
forall x. Rep SmuflGlyphName x -> SmuflGlyphName
forall x. SmuflGlyphName -> Rep SmuflGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmuflGlyphName x -> SmuflGlyphName
$cfrom :: forall x. SmuflGlyphName -> Rep SmuflGlyphName x
Generic,Eq SmuflGlyphName
Eq SmuflGlyphName
-> (SmuflGlyphName -> SmuflGlyphName -> Ordering)
-> (SmuflGlyphName -> SmuflGlyphName -> Bool)
-> (SmuflGlyphName -> SmuflGlyphName -> Bool)
-> (SmuflGlyphName -> SmuflGlyphName -> Bool)
-> (SmuflGlyphName -> SmuflGlyphName -> Bool)
-> (SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName)
-> (SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName)
-> Ord SmuflGlyphName
SmuflGlyphName -> SmuflGlyphName -> Bool
SmuflGlyphName -> SmuflGlyphName -> Ordering
SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName
$cmin :: SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName
max :: SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName
$cmax :: SmuflGlyphName -> SmuflGlyphName -> SmuflGlyphName
>= :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c>= :: SmuflGlyphName -> SmuflGlyphName -> Bool
> :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c> :: SmuflGlyphName -> SmuflGlyphName -> Bool
<= :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c<= :: SmuflGlyphName -> SmuflGlyphName -> Bool
< :: SmuflGlyphName -> SmuflGlyphName -> Bool
$c< :: SmuflGlyphName -> SmuflGlyphName -> Bool
compare :: SmuflGlyphName -> SmuflGlyphName -> Ordering
$ccompare :: SmuflGlyphName -> SmuflGlyphName -> Ordering
$cp1Ord :: Eq SmuflGlyphName
Ord,String -> SmuflGlyphName
(String -> SmuflGlyphName) -> IsString SmuflGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflGlyphName
$cfromString :: String -> SmuflGlyphName
IsString)
instance Show SmuflGlyphName where show :: SmuflGlyphName -> String
show (SmuflGlyphName NMTOKEN
a) = NMTOKEN -> String
forall a. Show a => a -> String
show NMTOKEN
a
instance Read SmuflGlyphName where readsPrec :: Int -> String -> [(SmuflGlyphName, String)]
readsPrec Int
i = ((NMTOKEN, String) -> (SmuflGlyphName, String))
-> [(NMTOKEN, String)] -> [(SmuflGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NMTOKEN -> SmuflGlyphName)
-> (NMTOKEN, String) -> (SmuflGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NMTOKEN -> SmuflGlyphName
SmuflGlyphName) ([(NMTOKEN, String)] -> [(SmuflGlyphName, String)])
-> ReadS NMTOKEN -> String -> [(SmuflGlyphName, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS NMTOKEN
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflGlyphName where
    emitXml :: SmuflGlyphName -> XmlRep
emitXml = NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NMTOKEN -> XmlRep)
-> (SmuflGlyphName -> NMTOKEN) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflGlyphName -> NMTOKEN
smuflGlyphName
parseSmuflGlyphName :: String -> P.XParse SmuflGlyphName
parseSmuflGlyphName :: String -> XParse SmuflGlyphName
parseSmuflGlyphName = SmuflGlyphName -> XParse SmuflGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflGlyphName -> XParse SmuflGlyphName)
-> (String -> SmuflGlyphName) -> String -> XParse SmuflGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflGlyphName
forall a. IsString a => String -> a
fromString

-- | @smufl-lyrics-glyph-name@ /(simple)/
--
-- The smufl-lyrics-glyph-name type is used to reference a specific Standard Music Font Layout (SMuFL) lyrics elision character. The value is a SMuFL canonical glyph name that starts with lyrics.
newtype SmuflLyricsGlyphName = SmuflLyricsGlyphName { SmuflLyricsGlyphName -> SmuflGlyphName
smuflLyricsGlyphName :: SmuflGlyphName }
    deriving (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
(SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> Eq SmuflLyricsGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c/= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
== :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c== :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
Eq,Typeable,(forall x. SmuflLyricsGlyphName -> Rep SmuflLyricsGlyphName x)
-> (forall x. Rep SmuflLyricsGlyphName x -> SmuflLyricsGlyphName)
-> Generic SmuflLyricsGlyphName
forall x. Rep SmuflLyricsGlyphName x -> SmuflLyricsGlyphName
forall x. SmuflLyricsGlyphName -> Rep SmuflLyricsGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmuflLyricsGlyphName x -> SmuflLyricsGlyphName
$cfrom :: forall x. SmuflLyricsGlyphName -> Rep SmuflLyricsGlyphName x
Generic,Eq SmuflLyricsGlyphName
Eq SmuflLyricsGlyphName
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Ordering)
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> (SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool)
-> (SmuflLyricsGlyphName
    -> SmuflLyricsGlyphName -> SmuflLyricsGlyphName)
-> (SmuflLyricsGlyphName
    -> SmuflLyricsGlyphName -> SmuflLyricsGlyphName)
-> Ord SmuflLyricsGlyphName
SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Ordering
SmuflLyricsGlyphName
-> SmuflLyricsGlyphName -> SmuflLyricsGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflLyricsGlyphName
-> SmuflLyricsGlyphName -> SmuflLyricsGlyphName
$cmin :: SmuflLyricsGlyphName
-> SmuflLyricsGlyphName -> SmuflLyricsGlyphName
max :: SmuflLyricsGlyphName
-> SmuflLyricsGlyphName -> SmuflLyricsGlyphName
$cmax :: SmuflLyricsGlyphName
-> SmuflLyricsGlyphName -> SmuflLyricsGlyphName
>= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c>= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
> :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c> :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
<= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c<= :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
< :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
$c< :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Bool
compare :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Ordering
$ccompare :: SmuflLyricsGlyphName -> SmuflLyricsGlyphName -> Ordering
$cp1Ord :: Eq SmuflLyricsGlyphName
Ord,String -> SmuflLyricsGlyphName
(String -> SmuflLyricsGlyphName) -> IsString SmuflLyricsGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflLyricsGlyphName
$cfromString :: String -> SmuflLyricsGlyphName
IsString)
instance Show SmuflLyricsGlyphName where show :: SmuflLyricsGlyphName -> String
show (SmuflLyricsGlyphName SmuflGlyphName
a) = SmuflGlyphName -> String
forall a. Show a => a -> String
show SmuflGlyphName
a
instance Read SmuflLyricsGlyphName where readsPrec :: Int -> ReadS SmuflLyricsGlyphName
readsPrec Int
i = ((SmuflGlyphName, String) -> (SmuflLyricsGlyphName, String))
-> [(SmuflGlyphName, String)] -> [(SmuflLyricsGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((SmuflGlyphName -> SmuflLyricsGlyphName)
-> (SmuflGlyphName, String) -> (SmuflLyricsGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first SmuflGlyphName -> SmuflLyricsGlyphName
SmuflLyricsGlyphName) ([(SmuflGlyphName, String)] -> [(SmuflLyricsGlyphName, String)])
-> (String -> [(SmuflGlyphName, String)])
-> ReadS SmuflLyricsGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(SmuflGlyphName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflLyricsGlyphName where
    emitXml :: SmuflLyricsGlyphName -> XmlRep
emitXml = SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (SmuflGlyphName -> XmlRep)
-> (SmuflLyricsGlyphName -> SmuflGlyphName)
-> SmuflLyricsGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflLyricsGlyphName -> SmuflGlyphName
smuflLyricsGlyphName
parseSmuflLyricsGlyphName :: String -> P.XParse SmuflLyricsGlyphName
parseSmuflLyricsGlyphName :: String -> XParse SmuflLyricsGlyphName
parseSmuflLyricsGlyphName = SmuflLyricsGlyphName -> XParse SmuflLyricsGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflLyricsGlyphName -> XParse SmuflLyricsGlyphName)
-> (String -> SmuflLyricsGlyphName)
-> String
-> XParse SmuflLyricsGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflLyricsGlyphName
forall a. IsString a => String -> a
fromString

-- | @smufl-pictogram-glyph-name@ /(simple)/
--
-- The smufl-pictogram-glyph-name type is used to reference a specific Standard Music Font Layout (SMuFL) percussion pictogram character. The value is a SMuFL canonical glyph name that starts with pict.
newtype SmuflPictogramGlyphName = SmuflPictogramGlyphName { SmuflPictogramGlyphName -> SmuflGlyphName
smuflPictogramGlyphName :: SmuflGlyphName }
    deriving (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
(SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> Eq SmuflPictogramGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c/= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
== :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c== :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
Eq,Typeable,(forall x.
 SmuflPictogramGlyphName -> Rep SmuflPictogramGlyphName x)
-> (forall x.
    Rep SmuflPictogramGlyphName x -> SmuflPictogramGlyphName)
-> Generic SmuflPictogramGlyphName
forall x. Rep SmuflPictogramGlyphName x -> SmuflPictogramGlyphName
forall x. SmuflPictogramGlyphName -> Rep SmuflPictogramGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmuflPictogramGlyphName x -> SmuflPictogramGlyphName
$cfrom :: forall x. SmuflPictogramGlyphName -> Rep SmuflPictogramGlyphName x
Generic,Eq SmuflPictogramGlyphName
Eq SmuflPictogramGlyphName
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Ordering)
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> (SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool)
-> (SmuflPictogramGlyphName
    -> SmuflPictogramGlyphName -> SmuflPictogramGlyphName)
-> (SmuflPictogramGlyphName
    -> SmuflPictogramGlyphName -> SmuflPictogramGlyphName)
-> Ord SmuflPictogramGlyphName
SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Ordering
SmuflPictogramGlyphName
-> SmuflPictogramGlyphName -> SmuflPictogramGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflPictogramGlyphName
-> SmuflPictogramGlyphName -> SmuflPictogramGlyphName
$cmin :: SmuflPictogramGlyphName
-> SmuflPictogramGlyphName -> SmuflPictogramGlyphName
max :: SmuflPictogramGlyphName
-> SmuflPictogramGlyphName -> SmuflPictogramGlyphName
$cmax :: SmuflPictogramGlyphName
-> SmuflPictogramGlyphName -> SmuflPictogramGlyphName
>= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c>= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
> :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c> :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
<= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c<= :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
< :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
$c< :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Bool
compare :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Ordering
$ccompare :: SmuflPictogramGlyphName -> SmuflPictogramGlyphName -> Ordering
$cp1Ord :: Eq SmuflPictogramGlyphName
Ord,String -> SmuflPictogramGlyphName
(String -> SmuflPictogramGlyphName)
-> IsString SmuflPictogramGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflPictogramGlyphName
$cfromString :: String -> SmuflPictogramGlyphName
IsString)
instance Show SmuflPictogramGlyphName where show :: SmuflPictogramGlyphName -> String
show (SmuflPictogramGlyphName SmuflGlyphName
a) = SmuflGlyphName -> String
forall a. Show a => a -> String
show SmuflGlyphName
a
instance Read SmuflPictogramGlyphName where readsPrec :: Int -> ReadS SmuflPictogramGlyphName
readsPrec Int
i = ((SmuflGlyphName, String) -> (SmuflPictogramGlyphName, String))
-> [(SmuflGlyphName, String)]
-> [(SmuflPictogramGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((SmuflGlyphName -> SmuflPictogramGlyphName)
-> (SmuflGlyphName, String) -> (SmuflPictogramGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first SmuflGlyphName -> SmuflPictogramGlyphName
SmuflPictogramGlyphName) ([(SmuflGlyphName, String)] -> [(SmuflPictogramGlyphName, String)])
-> (String -> [(SmuflGlyphName, String)])
-> ReadS SmuflPictogramGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(SmuflGlyphName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflPictogramGlyphName where
    emitXml :: SmuflPictogramGlyphName -> XmlRep
emitXml = SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (SmuflGlyphName -> XmlRep)
-> (SmuflPictogramGlyphName -> SmuflGlyphName)
-> SmuflPictogramGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflPictogramGlyphName -> SmuflGlyphName
smuflPictogramGlyphName
parseSmuflPictogramGlyphName :: String -> P.XParse SmuflPictogramGlyphName
parseSmuflPictogramGlyphName :: String -> XParse SmuflPictogramGlyphName
parseSmuflPictogramGlyphName = SmuflPictogramGlyphName -> XParse SmuflPictogramGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflPictogramGlyphName -> XParse SmuflPictogramGlyphName)
-> (String -> SmuflPictogramGlyphName)
-> String
-> XParse SmuflPictogramGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflPictogramGlyphName
forall a. IsString a => String -> a
fromString

-- | @smufl-segno-glyph-name@ /(simple)/
--
-- The smufl-segno-glyph-name type is used to reference a specific Standard Music Font Layout (SMuFL) segno character. The value is a SMuFL canonical glyph name that starts with segno.
newtype SmuflSegnoGlyphName = SmuflSegnoGlyphName { SmuflSegnoGlyphName -> SmuflGlyphName
smuflSegnoGlyphName :: SmuflGlyphName }
    deriving (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
(SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> Eq SmuflSegnoGlyphName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c/= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
== :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c== :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
Eq,Typeable,(forall x. SmuflSegnoGlyphName -> Rep SmuflSegnoGlyphName x)
-> (forall x. Rep SmuflSegnoGlyphName x -> SmuflSegnoGlyphName)
-> Generic SmuflSegnoGlyphName
forall x. Rep SmuflSegnoGlyphName x -> SmuflSegnoGlyphName
forall x. SmuflSegnoGlyphName -> Rep SmuflSegnoGlyphName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmuflSegnoGlyphName x -> SmuflSegnoGlyphName
$cfrom :: forall x. SmuflSegnoGlyphName -> Rep SmuflSegnoGlyphName x
Generic,Eq SmuflSegnoGlyphName
Eq SmuflSegnoGlyphName
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Ordering)
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> (SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool)
-> (SmuflSegnoGlyphName
    -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName)
-> (SmuflSegnoGlyphName
    -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName)
-> Ord SmuflSegnoGlyphName
SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Ordering
SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName
$cmin :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName
max :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName
$cmax :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> SmuflSegnoGlyphName
>= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c>= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
> :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c> :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
<= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c<= :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
< :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
$c< :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Bool
compare :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Ordering
$ccompare :: SmuflSegnoGlyphName -> SmuflSegnoGlyphName -> Ordering
$cp1Ord :: Eq SmuflSegnoGlyphName
Ord,String -> SmuflSegnoGlyphName
(String -> SmuflSegnoGlyphName) -> IsString SmuflSegnoGlyphName
forall a. (String -> a) -> IsString a
fromString :: String -> SmuflSegnoGlyphName
$cfromString :: String -> SmuflSegnoGlyphName
IsString)
instance Show SmuflSegnoGlyphName where show :: SmuflSegnoGlyphName -> String
show (SmuflSegnoGlyphName SmuflGlyphName
a) = SmuflGlyphName -> String
forall a. Show a => a -> String
show SmuflGlyphName
a
instance Read SmuflSegnoGlyphName where readsPrec :: Int -> ReadS SmuflSegnoGlyphName
readsPrec Int
i = ((SmuflGlyphName, String) -> (SmuflSegnoGlyphName, String))
-> [(SmuflGlyphName, String)] -> [(SmuflSegnoGlyphName, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((SmuflGlyphName -> SmuflSegnoGlyphName)
-> (SmuflGlyphName, String) -> (SmuflSegnoGlyphName, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first SmuflGlyphName -> SmuflSegnoGlyphName
SmuflSegnoGlyphName) ([(SmuflGlyphName, String)] -> [(SmuflSegnoGlyphName, String)])
-> (String -> [(SmuflGlyphName, String)])
-> ReadS SmuflSegnoGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(SmuflGlyphName, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml SmuflSegnoGlyphName where
    emitXml :: SmuflSegnoGlyphName -> XmlRep
emitXml = SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (SmuflGlyphName -> XmlRep)
-> (SmuflSegnoGlyphName -> SmuflGlyphName)
-> SmuflSegnoGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmuflSegnoGlyphName -> SmuflGlyphName
smuflSegnoGlyphName
parseSmuflSegnoGlyphName :: String -> P.XParse SmuflSegnoGlyphName
parseSmuflSegnoGlyphName :: String -> XParse SmuflSegnoGlyphName
parseSmuflSegnoGlyphName = SmuflSegnoGlyphName -> XParse SmuflSegnoGlyphName
forall (m :: * -> *) a. Monad m => a -> m a
return (SmuflSegnoGlyphName -> XParse SmuflSegnoGlyphName)
-> (String -> SmuflSegnoGlyphName)
-> String
-> XParse SmuflSegnoGlyphName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SmuflSegnoGlyphName
forall a. IsString a => String -> a
fromString

-- | @xml:space@ /(simple)/
data Space = 
      SpaceDefault -- ^ /default/
    | SpacePreserve -- ^ /preserve/
    deriving (Space -> Space -> Bool
(Space -> Space -> Bool) -> (Space -> Space -> Bool) -> Eq Space
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Space -> Space -> Bool
$c/= :: Space -> Space -> Bool
== :: Space -> Space -> Bool
$c== :: Space -> Space -> Bool
Eq,Typeable,(forall x. Space -> Rep Space x)
-> (forall x. Rep Space x -> Space) -> Generic Space
forall x. Rep Space x -> Space
forall x. Space -> Rep Space x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Space x -> Space
$cfrom :: forall x. Space -> Rep Space x
Generic,Int -> Space -> ShowS
[Space] -> ShowS
Space -> String
(Int -> Space -> ShowS)
-> (Space -> String) -> ([Space] -> ShowS) -> Show Space
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Space] -> ShowS
$cshowList :: [Space] -> ShowS
show :: Space -> String
$cshow :: Space -> String
showsPrec :: Int -> Space -> ShowS
$cshowsPrec :: Int -> Space -> ShowS
Show,Eq Space
Eq Space
-> (Space -> Space -> Ordering)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Bool)
-> (Space -> Space -> Space)
-> (Space -> Space -> Space)
-> Ord Space
Space -> Space -> Bool
Space -> Space -> Ordering
Space -> Space -> Space
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Space -> Space -> Space
$cmin :: Space -> Space -> Space
max :: Space -> Space -> Space
$cmax :: Space -> Space -> Space
>= :: Space -> Space -> Bool
$c>= :: Space -> Space -> Bool
> :: Space -> Space -> Bool
$c> :: Space -> Space -> Bool
<= :: Space -> Space -> Bool
$c<= :: Space -> Space -> Bool
< :: Space -> Space -> Bool
$c< :: Space -> Space -> Bool
compare :: Space -> Space -> Ordering
$ccompare :: Space -> Space -> Ordering
$cp1Ord :: Eq Space
Ord,Int -> Space
Space -> Int
Space -> [Space]
Space -> Space
Space -> Space -> [Space]
Space -> Space -> Space -> [Space]
(Space -> Space)
-> (Space -> Space)
-> (Int -> Space)
-> (Space -> Int)
-> (Space -> [Space])
-> (Space -> Space -> [Space])
-> (Space -> Space -> [Space])
-> (Space -> Space -> Space -> [Space])
-> Enum Space
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Space -> Space -> Space -> [Space]
$cenumFromThenTo :: Space -> Space -> Space -> [Space]
enumFromTo :: Space -> Space -> [Space]
$cenumFromTo :: Space -> Space -> [Space]
enumFromThen :: Space -> Space -> [Space]
$cenumFromThen :: Space -> Space -> [Space]
enumFrom :: Space -> [Space]
$cenumFrom :: Space -> [Space]
fromEnum :: Space -> Int
$cfromEnum :: Space -> Int
toEnum :: Int -> Space
$ctoEnum :: Int -> Space
pred :: Space -> Space
$cpred :: Space -> Space
succ :: Space -> Space
$csucc :: Space -> Space
Enum,Space
Space -> Space -> Bounded Space
forall a. a -> a -> Bounded a
maxBound :: Space
$cmaxBound :: Space
minBound :: Space
$cminBound :: Space
Bounded)
instance EmitXml Space where
    emitXml :: Space -> XmlRep
emitXml Space
SpaceDefault = String -> XmlRep
XLit String
"default"
    emitXml Space
SpacePreserve = String -> XmlRep
XLit String
"preserve"
parseSpace :: String -> P.XParse Space
parseSpace :: String -> XParse Space
parseSpace String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"default" = Space -> XParse Space
forall (m :: * -> *) a. Monad m => a -> m a
return (Space -> XParse Space) -> Space -> XParse Space
forall a b. (a -> b) -> a -> b
$ Space
SpaceDefault
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"preserve" = Space -> XParse Space
forall (m :: * -> *) a. Monad m => a -> m a
return (Space -> XParse Space) -> Space -> XParse Space
forall a b. (a -> b) -> a -> b
$ Space
SpacePreserve
        | Bool
otherwise = String -> XParse Space
forall a. String -> XParse a
P.xfail (String -> XParse Space) -> String -> XParse Space
forall a b. (a -> b) -> a -> b
$ String
"Space: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @staff-divide-symbol@ /(simple)/
--
-- The staff-divide-symbol type is used for staff division symbols. The down, up, and up-down values correspond to SMuFL code points U+E00B, U+E00C, and U+E00D respectively.
data StaffDivideSymbol = 
      StaffDivideSymbolDown -- ^ /down/
    | StaffDivideSymbolUp -- ^ /up/
    | StaffDivideSymbolUpDown -- ^ /up-down/
    deriving (StaffDivideSymbol -> StaffDivideSymbol -> Bool
(StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> (StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> Eq StaffDivideSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c/= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
== :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c== :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
Eq,Typeable,(forall x. StaffDivideSymbol -> Rep StaffDivideSymbol x)
-> (forall x. Rep StaffDivideSymbol x -> StaffDivideSymbol)
-> Generic StaffDivideSymbol
forall x. Rep StaffDivideSymbol x -> StaffDivideSymbol
forall x. StaffDivideSymbol -> Rep StaffDivideSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffDivideSymbol x -> StaffDivideSymbol
$cfrom :: forall x. StaffDivideSymbol -> Rep StaffDivideSymbol x
Generic,Int -> StaffDivideSymbol -> ShowS
[StaffDivideSymbol] -> ShowS
StaffDivideSymbol -> String
(Int -> StaffDivideSymbol -> ShowS)
-> (StaffDivideSymbol -> String)
-> ([StaffDivideSymbol] -> ShowS)
-> Show StaffDivideSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffDivideSymbol] -> ShowS
$cshowList :: [StaffDivideSymbol] -> ShowS
show :: StaffDivideSymbol -> String
$cshow :: StaffDivideSymbol -> String
showsPrec :: Int -> StaffDivideSymbol -> ShowS
$cshowsPrec :: Int -> StaffDivideSymbol -> ShowS
Show,Eq StaffDivideSymbol
Eq StaffDivideSymbol
-> (StaffDivideSymbol -> StaffDivideSymbol -> Ordering)
-> (StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> (StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> (StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> (StaffDivideSymbol -> StaffDivideSymbol -> Bool)
-> (StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol)
-> (StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol)
-> Ord StaffDivideSymbol
StaffDivideSymbol -> StaffDivideSymbol -> Bool
StaffDivideSymbol -> StaffDivideSymbol -> Ordering
StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol
$cmin :: StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol
max :: StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol
$cmax :: StaffDivideSymbol -> StaffDivideSymbol -> StaffDivideSymbol
>= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c>= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
> :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c> :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
<= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c<= :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
< :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
$c< :: StaffDivideSymbol -> StaffDivideSymbol -> Bool
compare :: StaffDivideSymbol -> StaffDivideSymbol -> Ordering
$ccompare :: StaffDivideSymbol -> StaffDivideSymbol -> Ordering
$cp1Ord :: Eq StaffDivideSymbol
Ord,Int -> StaffDivideSymbol
StaffDivideSymbol -> Int
StaffDivideSymbol -> [StaffDivideSymbol]
StaffDivideSymbol -> StaffDivideSymbol
StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
StaffDivideSymbol
-> StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
(StaffDivideSymbol -> StaffDivideSymbol)
-> (StaffDivideSymbol -> StaffDivideSymbol)
-> (Int -> StaffDivideSymbol)
-> (StaffDivideSymbol -> Int)
-> (StaffDivideSymbol -> [StaffDivideSymbol])
-> (StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol])
-> (StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol])
-> (StaffDivideSymbol
    -> StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol])
-> Enum StaffDivideSymbol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StaffDivideSymbol
-> StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
$cenumFromThenTo :: StaffDivideSymbol
-> StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
enumFromTo :: StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
$cenumFromTo :: StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
enumFromThen :: StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
$cenumFromThen :: StaffDivideSymbol -> StaffDivideSymbol -> [StaffDivideSymbol]
enumFrom :: StaffDivideSymbol -> [StaffDivideSymbol]
$cenumFrom :: StaffDivideSymbol -> [StaffDivideSymbol]
fromEnum :: StaffDivideSymbol -> Int
$cfromEnum :: StaffDivideSymbol -> Int
toEnum :: Int -> StaffDivideSymbol
$ctoEnum :: Int -> StaffDivideSymbol
pred :: StaffDivideSymbol -> StaffDivideSymbol
$cpred :: StaffDivideSymbol -> StaffDivideSymbol
succ :: StaffDivideSymbol -> StaffDivideSymbol
$csucc :: StaffDivideSymbol -> StaffDivideSymbol
Enum,StaffDivideSymbol
StaffDivideSymbol -> StaffDivideSymbol -> Bounded StaffDivideSymbol
forall a. a -> a -> Bounded a
maxBound :: StaffDivideSymbol
$cmaxBound :: StaffDivideSymbol
minBound :: StaffDivideSymbol
$cminBound :: StaffDivideSymbol
Bounded)
instance EmitXml StaffDivideSymbol where
    emitXml :: StaffDivideSymbol -> XmlRep
emitXml StaffDivideSymbol
StaffDivideSymbolDown = String -> XmlRep
XLit String
"down"
    emitXml StaffDivideSymbol
StaffDivideSymbolUp = String -> XmlRep
XLit String
"up"
    emitXml StaffDivideSymbol
StaffDivideSymbolUpDown = String -> XmlRep
XLit String
"up-down"
parseStaffDivideSymbol :: String -> P.XParse StaffDivideSymbol
parseStaffDivideSymbol :: String -> XParse StaffDivideSymbol
parseStaffDivideSymbol String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = StaffDivideSymbol -> XParse StaffDivideSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffDivideSymbol -> XParse StaffDivideSymbol)
-> StaffDivideSymbol -> XParse StaffDivideSymbol
forall a b. (a -> b) -> a -> b
$ StaffDivideSymbol
StaffDivideSymbolDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = StaffDivideSymbol -> XParse StaffDivideSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffDivideSymbol -> XParse StaffDivideSymbol)
-> StaffDivideSymbol -> XParse StaffDivideSymbol
forall a b. (a -> b) -> a -> b
$ StaffDivideSymbol
StaffDivideSymbolUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up-down" = StaffDivideSymbol -> XParse StaffDivideSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffDivideSymbol -> XParse StaffDivideSymbol)
-> StaffDivideSymbol -> XParse StaffDivideSymbol
forall a b. (a -> b) -> a -> b
$ StaffDivideSymbol
StaffDivideSymbolUpDown
        | Bool
otherwise = String -> XParse StaffDivideSymbol
forall a. String -> XParse a
P.xfail (String -> XParse StaffDivideSymbol)
-> String -> XParse StaffDivideSymbol
forall a b. (a -> b) -> a -> b
$ String
"StaffDivideSymbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @staff-line@ /(simple)/
--
-- The staff-line type indicates the line on a given staff. Staff lines are numbered from bottom to top, with 1 being the bottom line on a staff. Staff line values can be used to specify positions outside the staff, such as a C clef positioned in the middle of a grand staff.
newtype StaffLine = StaffLine { StaffLine -> Int
staffLine :: Int }
    deriving (StaffLine -> StaffLine -> Bool
(StaffLine -> StaffLine -> Bool)
-> (StaffLine -> StaffLine -> Bool) -> Eq StaffLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffLine -> StaffLine -> Bool
$c/= :: StaffLine -> StaffLine -> Bool
== :: StaffLine -> StaffLine -> Bool
$c== :: StaffLine -> StaffLine -> Bool
Eq,Typeable,(forall x. StaffLine -> Rep StaffLine x)
-> (forall x. Rep StaffLine x -> StaffLine) -> Generic StaffLine
forall x. Rep StaffLine x -> StaffLine
forall x. StaffLine -> Rep StaffLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffLine x -> StaffLine
$cfrom :: forall x. StaffLine -> Rep StaffLine x
Generic,Eq StaffLine
Eq StaffLine
-> (StaffLine -> StaffLine -> Ordering)
-> (StaffLine -> StaffLine -> Bool)
-> (StaffLine -> StaffLine -> Bool)
-> (StaffLine -> StaffLine -> Bool)
-> (StaffLine -> StaffLine -> Bool)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> Ord StaffLine
StaffLine -> StaffLine -> Bool
StaffLine -> StaffLine -> Ordering
StaffLine -> StaffLine -> StaffLine
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaffLine -> StaffLine -> StaffLine
$cmin :: StaffLine -> StaffLine -> StaffLine
max :: StaffLine -> StaffLine -> StaffLine
$cmax :: StaffLine -> StaffLine -> StaffLine
>= :: StaffLine -> StaffLine -> Bool
$c>= :: StaffLine -> StaffLine -> Bool
> :: StaffLine -> StaffLine -> Bool
$c> :: StaffLine -> StaffLine -> Bool
<= :: StaffLine -> StaffLine -> Bool
$c<= :: StaffLine -> StaffLine -> Bool
< :: StaffLine -> StaffLine -> Bool
$c< :: StaffLine -> StaffLine -> Bool
compare :: StaffLine -> StaffLine -> Ordering
$ccompare :: StaffLine -> StaffLine -> Ordering
$cp1Ord :: Eq StaffLine
Ord,StaffLine
StaffLine -> StaffLine -> Bounded StaffLine
forall a. a -> a -> Bounded a
maxBound :: StaffLine
$cmaxBound :: StaffLine
minBound :: StaffLine
$cminBound :: StaffLine
Bounded,Int -> StaffLine
StaffLine -> Int
StaffLine -> [StaffLine]
StaffLine -> StaffLine
StaffLine -> StaffLine -> [StaffLine]
StaffLine -> StaffLine -> StaffLine -> [StaffLine]
(StaffLine -> StaffLine)
-> (StaffLine -> StaffLine)
-> (Int -> StaffLine)
-> (StaffLine -> Int)
-> (StaffLine -> [StaffLine])
-> (StaffLine -> StaffLine -> [StaffLine])
-> (StaffLine -> StaffLine -> [StaffLine])
-> (StaffLine -> StaffLine -> StaffLine -> [StaffLine])
-> Enum StaffLine
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StaffLine -> StaffLine -> StaffLine -> [StaffLine]
$cenumFromThenTo :: StaffLine -> StaffLine -> StaffLine -> [StaffLine]
enumFromTo :: StaffLine -> StaffLine -> [StaffLine]
$cenumFromTo :: StaffLine -> StaffLine -> [StaffLine]
enumFromThen :: StaffLine -> StaffLine -> [StaffLine]
$cenumFromThen :: StaffLine -> StaffLine -> [StaffLine]
enumFrom :: StaffLine -> [StaffLine]
$cenumFrom :: StaffLine -> [StaffLine]
fromEnum :: StaffLine -> Int
$cfromEnum :: StaffLine -> Int
toEnum :: Int -> StaffLine
$ctoEnum :: Int -> StaffLine
pred :: StaffLine -> StaffLine
$cpred :: StaffLine -> StaffLine
succ :: StaffLine -> StaffLine
$csucc :: StaffLine -> StaffLine
Enum,Integer -> StaffLine
StaffLine -> StaffLine
StaffLine -> StaffLine -> StaffLine
(StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine)
-> (StaffLine -> StaffLine)
-> (StaffLine -> StaffLine)
-> (Integer -> StaffLine)
-> Num StaffLine
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StaffLine
$cfromInteger :: Integer -> StaffLine
signum :: StaffLine -> StaffLine
$csignum :: StaffLine -> StaffLine
abs :: StaffLine -> StaffLine
$cabs :: StaffLine -> StaffLine
negate :: StaffLine -> StaffLine
$cnegate :: StaffLine -> StaffLine
* :: StaffLine -> StaffLine -> StaffLine
$c* :: StaffLine -> StaffLine -> StaffLine
- :: StaffLine -> StaffLine -> StaffLine
$c- :: StaffLine -> StaffLine -> StaffLine
+ :: StaffLine -> StaffLine -> StaffLine
$c+ :: StaffLine -> StaffLine -> StaffLine
Num,Num StaffLine
Ord StaffLine
Num StaffLine
-> Ord StaffLine -> (StaffLine -> Rational) -> Real StaffLine
StaffLine -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: StaffLine -> Rational
$ctoRational :: StaffLine -> Rational
$cp2Real :: Ord StaffLine
$cp1Real :: Num StaffLine
Real,Enum StaffLine
Real StaffLine
Real StaffLine
-> Enum StaffLine
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> StaffLine)
-> (StaffLine -> StaffLine -> (StaffLine, StaffLine))
-> (StaffLine -> StaffLine -> (StaffLine, StaffLine))
-> (StaffLine -> Integer)
-> Integral StaffLine
StaffLine -> Integer
StaffLine -> StaffLine -> (StaffLine, StaffLine)
StaffLine -> StaffLine -> StaffLine
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: StaffLine -> Integer
$ctoInteger :: StaffLine -> Integer
divMod :: StaffLine -> StaffLine -> (StaffLine, StaffLine)
$cdivMod :: StaffLine -> StaffLine -> (StaffLine, StaffLine)
quotRem :: StaffLine -> StaffLine -> (StaffLine, StaffLine)
$cquotRem :: StaffLine -> StaffLine -> (StaffLine, StaffLine)
mod :: StaffLine -> StaffLine -> StaffLine
$cmod :: StaffLine -> StaffLine -> StaffLine
div :: StaffLine -> StaffLine -> StaffLine
$cdiv :: StaffLine -> StaffLine -> StaffLine
rem :: StaffLine -> StaffLine -> StaffLine
$crem :: StaffLine -> StaffLine -> StaffLine
quot :: StaffLine -> StaffLine -> StaffLine
$cquot :: StaffLine -> StaffLine -> StaffLine
$cp2Integral :: Enum StaffLine
$cp1Integral :: Real StaffLine
Integral)
instance Show StaffLine where show :: StaffLine -> String
show (StaffLine Int
a) = Int -> String
forall a. Show a => a -> String
show Int
a
instance Read StaffLine where readsPrec :: Int -> ReadS StaffLine
readsPrec Int
i = ((Int, String) -> (StaffLine, String))
-> [(Int, String)] -> [(StaffLine, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> StaffLine) -> (Int, String) -> (StaffLine, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Int -> StaffLine
StaffLine) ([(Int, String)] -> [(StaffLine, String)])
-> (String -> [(Int, String)]) -> ReadS StaffLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml StaffLine where
    emitXml :: StaffLine -> XmlRep
emitXml = Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Int -> XmlRep) -> (StaffLine -> Int) -> StaffLine -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaffLine -> Int
staffLine
parseStaffLine :: String -> P.XParse StaffLine
parseStaffLine :: String -> XParse StaffLine
parseStaffLine = String -> String -> XParse StaffLine
forall a. Read a => String -> String -> XParse a
P.xread String
"StaffLine"

-- | @staff-number@ /(simple)/
--
-- The staff-number type indicates staff numbers within a multi-staff part. Staves are numbered from top to bottom, with 1 being the top staff on a part.
newtype StaffNumber = StaffNumber { StaffNumber -> PositiveInteger
staffNumber :: PositiveInteger }
    deriving (StaffNumber -> StaffNumber -> Bool
(StaffNumber -> StaffNumber -> Bool)
-> (StaffNumber -> StaffNumber -> Bool) -> Eq StaffNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffNumber -> StaffNumber -> Bool
$c/= :: StaffNumber -> StaffNumber -> Bool
== :: StaffNumber -> StaffNumber -> Bool
$c== :: StaffNumber -> StaffNumber -> Bool
Eq,Typeable,(forall x. StaffNumber -> Rep StaffNumber x)
-> (forall x. Rep StaffNumber x -> StaffNumber)
-> Generic StaffNumber
forall x. Rep StaffNumber x -> StaffNumber
forall x. StaffNumber -> Rep StaffNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffNumber x -> StaffNumber
$cfrom :: forall x. StaffNumber -> Rep StaffNumber x
Generic,Eq StaffNumber
Eq StaffNumber
-> (StaffNumber -> StaffNumber -> Ordering)
-> (StaffNumber -> StaffNumber -> Bool)
-> (StaffNumber -> StaffNumber -> Bool)
-> (StaffNumber -> StaffNumber -> Bool)
-> (StaffNumber -> StaffNumber -> Bool)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> Ord StaffNumber
StaffNumber -> StaffNumber -> Bool
StaffNumber -> StaffNumber -> Ordering
StaffNumber -> StaffNumber -> StaffNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaffNumber -> StaffNumber -> StaffNumber
$cmin :: StaffNumber -> StaffNumber -> StaffNumber
max :: StaffNumber -> StaffNumber -> StaffNumber
$cmax :: StaffNumber -> StaffNumber -> StaffNumber
>= :: StaffNumber -> StaffNumber -> Bool
$c>= :: StaffNumber -> StaffNumber -> Bool
> :: StaffNumber -> StaffNumber -> Bool
$c> :: StaffNumber -> StaffNumber -> Bool
<= :: StaffNumber -> StaffNumber -> Bool
$c<= :: StaffNumber -> StaffNumber -> Bool
< :: StaffNumber -> StaffNumber -> Bool
$c< :: StaffNumber -> StaffNumber -> Bool
compare :: StaffNumber -> StaffNumber -> Ordering
$ccompare :: StaffNumber -> StaffNumber -> Ordering
$cp1Ord :: Eq StaffNumber
Ord,StaffNumber
StaffNumber -> StaffNumber -> Bounded StaffNumber
forall a. a -> a -> Bounded a
maxBound :: StaffNumber
$cmaxBound :: StaffNumber
minBound :: StaffNumber
$cminBound :: StaffNumber
Bounded,Int -> StaffNumber
StaffNumber -> Int
StaffNumber -> [StaffNumber]
StaffNumber -> StaffNumber
StaffNumber -> StaffNumber -> [StaffNumber]
StaffNumber -> StaffNumber -> StaffNumber -> [StaffNumber]
(StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber)
-> (Int -> StaffNumber)
-> (StaffNumber -> Int)
-> (StaffNumber -> [StaffNumber])
-> (StaffNumber -> StaffNumber -> [StaffNumber])
-> (StaffNumber -> StaffNumber -> [StaffNumber])
-> (StaffNumber -> StaffNumber -> StaffNumber -> [StaffNumber])
-> Enum StaffNumber
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StaffNumber -> StaffNumber -> StaffNumber -> [StaffNumber]
$cenumFromThenTo :: StaffNumber -> StaffNumber -> StaffNumber -> [StaffNumber]
enumFromTo :: StaffNumber -> StaffNumber -> [StaffNumber]
$cenumFromTo :: StaffNumber -> StaffNumber -> [StaffNumber]
enumFromThen :: StaffNumber -> StaffNumber -> [StaffNumber]
$cenumFromThen :: StaffNumber -> StaffNumber -> [StaffNumber]
enumFrom :: StaffNumber -> [StaffNumber]
$cenumFrom :: StaffNumber -> [StaffNumber]
fromEnum :: StaffNumber -> Int
$cfromEnum :: StaffNumber -> Int
toEnum :: Int -> StaffNumber
$ctoEnum :: Int -> StaffNumber
pred :: StaffNumber -> StaffNumber
$cpred :: StaffNumber -> StaffNumber
succ :: StaffNumber -> StaffNumber
$csucc :: StaffNumber -> StaffNumber
Enum,Integer -> StaffNumber
StaffNumber -> StaffNumber
StaffNumber -> StaffNumber -> StaffNumber
(StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber)
-> (Integer -> StaffNumber)
-> Num StaffNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StaffNumber
$cfromInteger :: Integer -> StaffNumber
signum :: StaffNumber -> StaffNumber
$csignum :: StaffNumber -> StaffNumber
abs :: StaffNumber -> StaffNumber
$cabs :: StaffNumber -> StaffNumber
negate :: StaffNumber -> StaffNumber
$cnegate :: StaffNumber -> StaffNumber
* :: StaffNumber -> StaffNumber -> StaffNumber
$c* :: StaffNumber -> StaffNumber -> StaffNumber
- :: StaffNumber -> StaffNumber -> StaffNumber
$c- :: StaffNumber -> StaffNumber -> StaffNumber
+ :: StaffNumber -> StaffNumber -> StaffNumber
$c+ :: StaffNumber -> StaffNumber -> StaffNumber
Num,Num StaffNumber
Ord StaffNumber
Num StaffNumber
-> Ord StaffNumber -> (StaffNumber -> Rational) -> Real StaffNumber
StaffNumber -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: StaffNumber -> Rational
$ctoRational :: StaffNumber -> Rational
$cp2Real :: Ord StaffNumber
$cp1Real :: Num StaffNumber
Real,Enum StaffNumber
Real StaffNumber
Real StaffNumber
-> Enum StaffNumber
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> StaffNumber)
-> (StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber))
-> (StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber))
-> (StaffNumber -> Integer)
-> Integral StaffNumber
StaffNumber -> Integer
StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber)
StaffNumber -> StaffNumber -> StaffNumber
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: StaffNumber -> Integer
$ctoInteger :: StaffNumber -> Integer
divMod :: StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber)
$cdivMod :: StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber)
quotRem :: StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber)
$cquotRem :: StaffNumber -> StaffNumber -> (StaffNumber, StaffNumber)
mod :: StaffNumber -> StaffNumber -> StaffNumber
$cmod :: StaffNumber -> StaffNumber -> StaffNumber
div :: StaffNumber -> StaffNumber -> StaffNumber
$cdiv :: StaffNumber -> StaffNumber -> StaffNumber
rem :: StaffNumber -> StaffNumber -> StaffNumber
$crem :: StaffNumber -> StaffNumber -> StaffNumber
quot :: StaffNumber -> StaffNumber -> StaffNumber
$cquot :: StaffNumber -> StaffNumber -> StaffNumber
$cp2Integral :: Enum StaffNumber
$cp1Integral :: Real StaffNumber
Integral)
instance Show StaffNumber where show :: StaffNumber -> String
show (StaffNumber PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read StaffNumber where readsPrec :: Int -> ReadS StaffNumber
readsPrec Int
i = ((PositiveInteger, String) -> (StaffNumber, String))
-> [(PositiveInteger, String)] -> [(StaffNumber, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> StaffNumber)
-> (PositiveInteger, String) -> (StaffNumber, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> StaffNumber
StaffNumber) ([(PositiveInteger, String)] -> [(StaffNumber, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS StaffNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml StaffNumber where
    emitXml :: StaffNumber -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (StaffNumber -> PositiveInteger) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaffNumber -> PositiveInteger
staffNumber
parseStaffNumber :: String -> P.XParse StaffNumber
parseStaffNumber :: String -> XParse StaffNumber
parseStaffNumber = String -> String -> XParse StaffNumber
forall a. Read a => String -> String -> XParse a
P.xread String
"StaffNumber"

-- | @staff-type@ /(simple)/
--
-- The staff-type value can be ossia, cue, editorial, regular, or alternate. An alternate staff indicates one that shares the same musical data as the prior staff, but displayed differently (e.g., treble and bass clef, standard notation and tab).
data StaffType = 
      StaffTypeOssia -- ^ /ossia/
    | StaffTypeCue -- ^ /cue/
    | StaffTypeEditorial -- ^ /editorial/
    | StaffTypeRegular -- ^ /regular/
    | StaffTypeAlternate -- ^ /alternate/
    deriving (StaffType -> StaffType -> Bool
(StaffType -> StaffType -> Bool)
-> (StaffType -> StaffType -> Bool) -> Eq StaffType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffType -> StaffType -> Bool
$c/= :: StaffType -> StaffType -> Bool
== :: StaffType -> StaffType -> Bool
$c== :: StaffType -> StaffType -> Bool
Eq,Typeable,(forall x. StaffType -> Rep StaffType x)
-> (forall x. Rep StaffType x -> StaffType) -> Generic StaffType
forall x. Rep StaffType x -> StaffType
forall x. StaffType -> Rep StaffType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffType x -> StaffType
$cfrom :: forall x. StaffType -> Rep StaffType x
Generic,Int -> StaffType -> ShowS
[StaffType] -> ShowS
StaffType -> String
(Int -> StaffType -> ShowS)
-> (StaffType -> String)
-> ([StaffType] -> ShowS)
-> Show StaffType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffType] -> ShowS
$cshowList :: [StaffType] -> ShowS
show :: StaffType -> String
$cshow :: StaffType -> String
showsPrec :: Int -> StaffType -> ShowS
$cshowsPrec :: Int -> StaffType -> ShowS
Show,Eq StaffType
Eq StaffType
-> (StaffType -> StaffType -> Ordering)
-> (StaffType -> StaffType -> Bool)
-> (StaffType -> StaffType -> Bool)
-> (StaffType -> StaffType -> Bool)
-> (StaffType -> StaffType -> Bool)
-> (StaffType -> StaffType -> StaffType)
-> (StaffType -> StaffType -> StaffType)
-> Ord StaffType
StaffType -> StaffType -> Bool
StaffType -> StaffType -> Ordering
StaffType -> StaffType -> StaffType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StaffType -> StaffType -> StaffType
$cmin :: StaffType -> StaffType -> StaffType
max :: StaffType -> StaffType -> StaffType
$cmax :: StaffType -> StaffType -> StaffType
>= :: StaffType -> StaffType -> Bool
$c>= :: StaffType -> StaffType -> Bool
> :: StaffType -> StaffType -> Bool
$c> :: StaffType -> StaffType -> Bool
<= :: StaffType -> StaffType -> Bool
$c<= :: StaffType -> StaffType -> Bool
< :: StaffType -> StaffType -> Bool
$c< :: StaffType -> StaffType -> Bool
compare :: StaffType -> StaffType -> Ordering
$ccompare :: StaffType -> StaffType -> Ordering
$cp1Ord :: Eq StaffType
Ord,Int -> StaffType
StaffType -> Int
StaffType -> [StaffType]
StaffType -> StaffType
StaffType -> StaffType -> [StaffType]
StaffType -> StaffType -> StaffType -> [StaffType]
(StaffType -> StaffType)
-> (StaffType -> StaffType)
-> (Int -> StaffType)
-> (StaffType -> Int)
-> (StaffType -> [StaffType])
-> (StaffType -> StaffType -> [StaffType])
-> (StaffType -> StaffType -> [StaffType])
-> (StaffType -> StaffType -> StaffType -> [StaffType])
-> Enum StaffType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StaffType -> StaffType -> StaffType -> [StaffType]
$cenumFromThenTo :: StaffType -> StaffType -> StaffType -> [StaffType]
enumFromTo :: StaffType -> StaffType -> [StaffType]
$cenumFromTo :: StaffType -> StaffType -> [StaffType]
enumFromThen :: StaffType -> StaffType -> [StaffType]
$cenumFromThen :: StaffType -> StaffType -> [StaffType]
enumFrom :: StaffType -> [StaffType]
$cenumFrom :: StaffType -> [StaffType]
fromEnum :: StaffType -> Int
$cfromEnum :: StaffType -> Int
toEnum :: Int -> StaffType
$ctoEnum :: Int -> StaffType
pred :: StaffType -> StaffType
$cpred :: StaffType -> StaffType
succ :: StaffType -> StaffType
$csucc :: StaffType -> StaffType
Enum,StaffType
StaffType -> StaffType -> Bounded StaffType
forall a. a -> a -> Bounded a
maxBound :: StaffType
$cmaxBound :: StaffType
minBound :: StaffType
$cminBound :: StaffType
Bounded)
instance EmitXml StaffType where
    emitXml :: StaffType -> XmlRep
emitXml StaffType
StaffTypeOssia = String -> XmlRep
XLit String
"ossia"
    emitXml StaffType
StaffTypeCue = String -> XmlRep
XLit String
"cue"
    emitXml StaffType
StaffTypeEditorial = String -> XmlRep
XLit String
"editorial"
    emitXml StaffType
StaffTypeRegular = String -> XmlRep
XLit String
"regular"
    emitXml StaffType
StaffTypeAlternate = String -> XmlRep
XLit String
"alternate"
parseStaffType :: String -> P.XParse StaffType
parseStaffType :: String -> XParse StaffType
parseStaffType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ossia" = StaffType -> XParse StaffType
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffType -> XParse StaffType) -> StaffType -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ StaffType
StaffTypeOssia
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cue" = StaffType -> XParse StaffType
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffType -> XParse StaffType) -> StaffType -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ StaffType
StaffTypeCue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"editorial" = StaffType -> XParse StaffType
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffType -> XParse StaffType) -> StaffType -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ StaffType
StaffTypeEditorial
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"regular" = StaffType -> XParse StaffType
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffType -> XParse StaffType) -> StaffType -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ StaffType
StaffTypeRegular
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"alternate" = StaffType -> XParse StaffType
forall (m :: * -> *) a. Monad m => a -> m a
return (StaffType -> XParse StaffType) -> StaffType -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ StaffType
StaffTypeAlternate
        | Bool
otherwise = String -> XParse StaffType
forall a. String -> XParse a
P.xfail (String -> XParse StaffType) -> String -> XParse StaffType
forall a b. (a -> b) -> a -> b
$ String
"StaffType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @start-note@ /(simple)/
--
-- The start-note type describes the starting note of trills and mordents for playback, relative to the current note.
data StartNote = 
      StartNoteUpper -- ^ /upper/
    | StartNoteMain -- ^ /main/
    | StartNoteBelow -- ^ /below/
    deriving (StartNote -> StartNote -> Bool
(StartNote -> StartNote -> Bool)
-> (StartNote -> StartNote -> Bool) -> Eq StartNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartNote -> StartNote -> Bool
$c/= :: StartNote -> StartNote -> Bool
== :: StartNote -> StartNote -> Bool
$c== :: StartNote -> StartNote -> Bool
Eq,Typeable,(forall x. StartNote -> Rep StartNote x)
-> (forall x. Rep StartNote x -> StartNote) -> Generic StartNote
forall x. Rep StartNote x -> StartNote
forall x. StartNote -> Rep StartNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartNote x -> StartNote
$cfrom :: forall x. StartNote -> Rep StartNote x
Generic,Int -> StartNote -> ShowS
[StartNote] -> ShowS
StartNote -> String
(Int -> StartNote -> ShowS)
-> (StartNote -> String)
-> ([StartNote] -> ShowS)
-> Show StartNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartNote] -> ShowS
$cshowList :: [StartNote] -> ShowS
show :: StartNote -> String
$cshow :: StartNote -> String
showsPrec :: Int -> StartNote -> ShowS
$cshowsPrec :: Int -> StartNote -> ShowS
Show,Eq StartNote
Eq StartNote
-> (StartNote -> StartNote -> Ordering)
-> (StartNote -> StartNote -> Bool)
-> (StartNote -> StartNote -> Bool)
-> (StartNote -> StartNote -> Bool)
-> (StartNote -> StartNote -> Bool)
-> (StartNote -> StartNote -> StartNote)
-> (StartNote -> StartNote -> StartNote)
-> Ord StartNote
StartNote -> StartNote -> Bool
StartNote -> StartNote -> Ordering
StartNote -> StartNote -> StartNote
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartNote -> StartNote -> StartNote
$cmin :: StartNote -> StartNote -> StartNote
max :: StartNote -> StartNote -> StartNote
$cmax :: StartNote -> StartNote -> StartNote
>= :: StartNote -> StartNote -> Bool
$c>= :: StartNote -> StartNote -> Bool
> :: StartNote -> StartNote -> Bool
$c> :: StartNote -> StartNote -> Bool
<= :: StartNote -> StartNote -> Bool
$c<= :: StartNote -> StartNote -> Bool
< :: StartNote -> StartNote -> Bool
$c< :: StartNote -> StartNote -> Bool
compare :: StartNote -> StartNote -> Ordering
$ccompare :: StartNote -> StartNote -> Ordering
$cp1Ord :: Eq StartNote
Ord,Int -> StartNote
StartNote -> Int
StartNote -> [StartNote]
StartNote -> StartNote
StartNote -> StartNote -> [StartNote]
StartNote -> StartNote -> StartNote -> [StartNote]
(StartNote -> StartNote)
-> (StartNote -> StartNote)
-> (Int -> StartNote)
-> (StartNote -> Int)
-> (StartNote -> [StartNote])
-> (StartNote -> StartNote -> [StartNote])
-> (StartNote -> StartNote -> [StartNote])
-> (StartNote -> StartNote -> StartNote -> [StartNote])
-> Enum StartNote
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartNote -> StartNote -> StartNote -> [StartNote]
$cenumFromThenTo :: StartNote -> StartNote -> StartNote -> [StartNote]
enumFromTo :: StartNote -> StartNote -> [StartNote]
$cenumFromTo :: StartNote -> StartNote -> [StartNote]
enumFromThen :: StartNote -> StartNote -> [StartNote]
$cenumFromThen :: StartNote -> StartNote -> [StartNote]
enumFrom :: StartNote -> [StartNote]
$cenumFrom :: StartNote -> [StartNote]
fromEnum :: StartNote -> Int
$cfromEnum :: StartNote -> Int
toEnum :: Int -> StartNote
$ctoEnum :: Int -> StartNote
pred :: StartNote -> StartNote
$cpred :: StartNote -> StartNote
succ :: StartNote -> StartNote
$csucc :: StartNote -> StartNote
Enum,StartNote
StartNote -> StartNote -> Bounded StartNote
forall a. a -> a -> Bounded a
maxBound :: StartNote
$cmaxBound :: StartNote
minBound :: StartNote
$cminBound :: StartNote
Bounded)
instance EmitXml StartNote where
    emitXml :: StartNote -> XmlRep
emitXml StartNote
StartNoteUpper = String -> XmlRep
XLit String
"upper"
    emitXml StartNote
StartNoteMain = String -> XmlRep
XLit String
"main"
    emitXml StartNote
StartNoteBelow = String -> XmlRep
XLit String
"below"
parseStartNote :: String -> P.XParse StartNote
parseStartNote :: String -> XParse StartNote
parseStartNote String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"upper" = StartNote -> XParse StartNote
forall (m :: * -> *) a. Monad m => a -> m a
return (StartNote -> XParse StartNote) -> StartNote -> XParse StartNote
forall a b. (a -> b) -> a -> b
$ StartNote
StartNoteUpper
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"main" = StartNote -> XParse StartNote
forall (m :: * -> *) a. Monad m => a -> m a
return (StartNote -> XParse StartNote) -> StartNote -> XParse StartNote
forall a b. (a -> b) -> a -> b
$ StartNote
StartNoteMain
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"below" = StartNote -> XParse StartNote
forall (m :: * -> *) a. Monad m => a -> m a
return (StartNote -> XParse StartNote) -> StartNote -> XParse StartNote
forall a b. (a -> b) -> a -> b
$ StartNote
StartNoteBelow
        | Bool
otherwise = String -> XParse StartNote
forall a. String -> XParse a
P.xfail (String -> XParse StartNote) -> String -> XParse StartNote
forall a b. (a -> b) -> a -> b
$ String
"StartNote: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @start-stop@ /(simple)/
--
-- The start-stop type is used for an attribute of musical elements that can either start or stop, such as tuplets.
-- 
-- The values of start and stop refer to how an element appears in musical score order, not in MusicXML document order. An element with a stop attribute may precede the corresponding element with a start attribute within a MusicXML document. This is particularly common in multi-staff music. For example, the stopping point for a tuplet may appear in staff 1 before the starting point for the tuplet appears in staff 2 later in the document.
data StartStop = 
      StartStopStart -- ^ /start/
    | StartStopStop -- ^ /stop/
    deriving (StartStop -> StartStop -> Bool
(StartStop -> StartStop -> Bool)
-> (StartStop -> StartStop -> Bool) -> Eq StartStop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStop -> StartStop -> Bool
$c/= :: StartStop -> StartStop -> Bool
== :: StartStop -> StartStop -> Bool
$c== :: StartStop -> StartStop -> Bool
Eq,Typeable,(forall x. StartStop -> Rep StartStop x)
-> (forall x. Rep StartStop x -> StartStop) -> Generic StartStop
forall x. Rep StartStop x -> StartStop
forall x. StartStop -> Rep StartStop x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartStop x -> StartStop
$cfrom :: forall x. StartStop -> Rep StartStop x
Generic,Int -> StartStop -> ShowS
[StartStop] -> ShowS
StartStop -> String
(Int -> StartStop -> ShowS)
-> (StartStop -> String)
-> ([StartStop] -> ShowS)
-> Show StartStop
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStop] -> ShowS
$cshowList :: [StartStop] -> ShowS
show :: StartStop -> String
$cshow :: StartStop -> String
showsPrec :: Int -> StartStop -> ShowS
$cshowsPrec :: Int -> StartStop -> ShowS
Show,Eq StartStop
Eq StartStop
-> (StartStop -> StartStop -> Ordering)
-> (StartStop -> StartStop -> Bool)
-> (StartStop -> StartStop -> Bool)
-> (StartStop -> StartStop -> Bool)
-> (StartStop -> StartStop -> Bool)
-> (StartStop -> StartStop -> StartStop)
-> (StartStop -> StartStop -> StartStop)
-> Ord StartStop
StartStop -> StartStop -> Bool
StartStop -> StartStop -> Ordering
StartStop -> StartStop -> StartStop
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartStop -> StartStop -> StartStop
$cmin :: StartStop -> StartStop -> StartStop
max :: StartStop -> StartStop -> StartStop
$cmax :: StartStop -> StartStop -> StartStop
>= :: StartStop -> StartStop -> Bool
$c>= :: StartStop -> StartStop -> Bool
> :: StartStop -> StartStop -> Bool
$c> :: StartStop -> StartStop -> Bool
<= :: StartStop -> StartStop -> Bool
$c<= :: StartStop -> StartStop -> Bool
< :: StartStop -> StartStop -> Bool
$c< :: StartStop -> StartStop -> Bool
compare :: StartStop -> StartStop -> Ordering
$ccompare :: StartStop -> StartStop -> Ordering
$cp1Ord :: Eq StartStop
Ord,Int -> StartStop
StartStop -> Int
StartStop -> [StartStop]
StartStop -> StartStop
StartStop -> StartStop -> [StartStop]
StartStop -> StartStop -> StartStop -> [StartStop]
(StartStop -> StartStop)
-> (StartStop -> StartStop)
-> (Int -> StartStop)
-> (StartStop -> Int)
-> (StartStop -> [StartStop])
-> (StartStop -> StartStop -> [StartStop])
-> (StartStop -> StartStop -> [StartStop])
-> (StartStop -> StartStop -> StartStop -> [StartStop])
-> Enum StartStop
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartStop -> StartStop -> StartStop -> [StartStop]
$cenumFromThenTo :: StartStop -> StartStop -> StartStop -> [StartStop]
enumFromTo :: StartStop -> StartStop -> [StartStop]
$cenumFromTo :: StartStop -> StartStop -> [StartStop]
enumFromThen :: StartStop -> StartStop -> [StartStop]
$cenumFromThen :: StartStop -> StartStop -> [StartStop]
enumFrom :: StartStop -> [StartStop]
$cenumFrom :: StartStop -> [StartStop]
fromEnum :: StartStop -> Int
$cfromEnum :: StartStop -> Int
toEnum :: Int -> StartStop
$ctoEnum :: Int -> StartStop
pred :: StartStop -> StartStop
$cpred :: StartStop -> StartStop
succ :: StartStop -> StartStop
$csucc :: StartStop -> StartStop
Enum,StartStop
StartStop -> StartStop -> Bounded StartStop
forall a. a -> a -> Bounded a
maxBound :: StartStop
$cmaxBound :: StartStop
minBound :: StartStop
$cminBound :: StartStop
Bounded)
instance EmitXml StartStop where
    emitXml :: StartStop -> XmlRep
emitXml StartStop
StartStopStart = String -> XmlRep
XLit String
"start"
    emitXml StartStop
StartStopStop = String -> XmlRep
XLit String
"stop"
parseStartStop :: String -> P.XParse StartStop
parseStartStop :: String -> XParse StartStop
parseStartStop String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = StartStop -> XParse StartStop
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStop -> XParse StartStop) -> StartStop -> XParse StartStop
forall a b. (a -> b) -> a -> b
$ StartStop
StartStopStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = StartStop -> XParse StartStop
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStop -> XParse StartStop) -> StartStop -> XParse StartStop
forall a b. (a -> b) -> a -> b
$ StartStop
StartStopStop
        | Bool
otherwise = String -> XParse StartStop
forall a. String -> XParse a
P.xfail (String -> XParse StartStop) -> String -> XParse StartStop
forall a b. (a -> b) -> a -> b
$ String
"StartStop: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @start-stop-continue@ /(simple)/
--
-- The start-stop-continue type is used for an attribute of musical elements that can either start or stop, but also need to refer to an intermediate point in the symbol, as for complex slurs or for formatting of symbols across system breaks.
-- 
-- The values of start, stop, and continue refer to how an element appears in musical score order, not in MusicXML document order. An element with a stop attribute may precede the corresponding element with a start attribute within a MusicXML document. This is particularly common in multi-staff music. For example, the stopping point for a slur may appear in staff 1 before the starting point for the slur appears in staff 2 later in the document.
data StartStopContinue = 
      StartStopContinueStart -- ^ /start/
    | StartStopContinueStop -- ^ /stop/
    | StartStopContinueContinue -- ^ /continue/
    deriving (StartStopContinue -> StartStopContinue -> Bool
(StartStopContinue -> StartStopContinue -> Bool)
-> (StartStopContinue -> StartStopContinue -> Bool)
-> Eq StartStopContinue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStopContinue -> StartStopContinue -> Bool
$c/= :: StartStopContinue -> StartStopContinue -> Bool
== :: StartStopContinue -> StartStopContinue -> Bool
$c== :: StartStopContinue -> StartStopContinue -> Bool
Eq,Typeable,(forall x. StartStopContinue -> Rep StartStopContinue x)
-> (forall x. Rep StartStopContinue x -> StartStopContinue)
-> Generic StartStopContinue
forall x. Rep StartStopContinue x -> StartStopContinue
forall x. StartStopContinue -> Rep StartStopContinue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartStopContinue x -> StartStopContinue
$cfrom :: forall x. StartStopContinue -> Rep StartStopContinue x
Generic,Int -> StartStopContinue -> ShowS
[StartStopContinue] -> ShowS
StartStopContinue -> String
(Int -> StartStopContinue -> ShowS)
-> (StartStopContinue -> String)
-> ([StartStopContinue] -> ShowS)
-> Show StartStopContinue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStopContinue] -> ShowS
$cshowList :: [StartStopContinue] -> ShowS
show :: StartStopContinue -> String
$cshow :: StartStopContinue -> String
showsPrec :: Int -> StartStopContinue -> ShowS
$cshowsPrec :: Int -> StartStopContinue -> ShowS
Show,Eq StartStopContinue
Eq StartStopContinue
-> (StartStopContinue -> StartStopContinue -> Ordering)
-> (StartStopContinue -> StartStopContinue -> Bool)
-> (StartStopContinue -> StartStopContinue -> Bool)
-> (StartStopContinue -> StartStopContinue -> Bool)
-> (StartStopContinue -> StartStopContinue -> Bool)
-> (StartStopContinue -> StartStopContinue -> StartStopContinue)
-> (StartStopContinue -> StartStopContinue -> StartStopContinue)
-> Ord StartStopContinue
StartStopContinue -> StartStopContinue -> Bool
StartStopContinue -> StartStopContinue -> Ordering
StartStopContinue -> StartStopContinue -> StartStopContinue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartStopContinue -> StartStopContinue -> StartStopContinue
$cmin :: StartStopContinue -> StartStopContinue -> StartStopContinue
max :: StartStopContinue -> StartStopContinue -> StartStopContinue
$cmax :: StartStopContinue -> StartStopContinue -> StartStopContinue
>= :: StartStopContinue -> StartStopContinue -> Bool
$c>= :: StartStopContinue -> StartStopContinue -> Bool
> :: StartStopContinue -> StartStopContinue -> Bool
$c> :: StartStopContinue -> StartStopContinue -> Bool
<= :: StartStopContinue -> StartStopContinue -> Bool
$c<= :: StartStopContinue -> StartStopContinue -> Bool
< :: StartStopContinue -> StartStopContinue -> Bool
$c< :: StartStopContinue -> StartStopContinue -> Bool
compare :: StartStopContinue -> StartStopContinue -> Ordering
$ccompare :: StartStopContinue -> StartStopContinue -> Ordering
$cp1Ord :: Eq StartStopContinue
Ord,Int -> StartStopContinue
StartStopContinue -> Int
StartStopContinue -> [StartStopContinue]
StartStopContinue -> StartStopContinue
StartStopContinue -> StartStopContinue -> [StartStopContinue]
StartStopContinue
-> StartStopContinue -> StartStopContinue -> [StartStopContinue]
(StartStopContinue -> StartStopContinue)
-> (StartStopContinue -> StartStopContinue)
-> (Int -> StartStopContinue)
-> (StartStopContinue -> Int)
-> (StartStopContinue -> [StartStopContinue])
-> (StartStopContinue -> StartStopContinue -> [StartStopContinue])
-> (StartStopContinue -> StartStopContinue -> [StartStopContinue])
-> (StartStopContinue
    -> StartStopContinue -> StartStopContinue -> [StartStopContinue])
-> Enum StartStopContinue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartStopContinue
-> StartStopContinue -> StartStopContinue -> [StartStopContinue]
$cenumFromThenTo :: StartStopContinue
-> StartStopContinue -> StartStopContinue -> [StartStopContinue]
enumFromTo :: StartStopContinue -> StartStopContinue -> [StartStopContinue]
$cenumFromTo :: StartStopContinue -> StartStopContinue -> [StartStopContinue]
enumFromThen :: StartStopContinue -> StartStopContinue -> [StartStopContinue]
$cenumFromThen :: StartStopContinue -> StartStopContinue -> [StartStopContinue]
enumFrom :: StartStopContinue -> [StartStopContinue]
$cenumFrom :: StartStopContinue -> [StartStopContinue]
fromEnum :: StartStopContinue -> Int
$cfromEnum :: StartStopContinue -> Int
toEnum :: Int -> StartStopContinue
$ctoEnum :: Int -> StartStopContinue
pred :: StartStopContinue -> StartStopContinue
$cpred :: StartStopContinue -> StartStopContinue
succ :: StartStopContinue -> StartStopContinue
$csucc :: StartStopContinue -> StartStopContinue
Enum,StartStopContinue
StartStopContinue -> StartStopContinue -> Bounded StartStopContinue
forall a. a -> a -> Bounded a
maxBound :: StartStopContinue
$cmaxBound :: StartStopContinue
minBound :: StartStopContinue
$cminBound :: StartStopContinue
Bounded)
instance EmitXml StartStopContinue where
    emitXml :: StartStopContinue -> XmlRep
emitXml StartStopContinue
StartStopContinueStart = String -> XmlRep
XLit String
"start"
    emitXml StartStopContinue
StartStopContinueStop = String -> XmlRep
XLit String
"stop"
    emitXml StartStopContinue
StartStopContinueContinue = String -> XmlRep
XLit String
"continue"
parseStartStopContinue :: String -> P.XParse StartStopContinue
parseStartStopContinue :: String -> XParse StartStopContinue
parseStartStopContinue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = StartStopContinue -> XParse StartStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopContinue -> XParse StartStopContinue)
-> StartStopContinue -> XParse StartStopContinue
forall a b. (a -> b) -> a -> b
$ StartStopContinue
StartStopContinueStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = StartStopContinue -> XParse StartStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopContinue -> XParse StartStopContinue)
-> StartStopContinue -> XParse StartStopContinue
forall a b. (a -> b) -> a -> b
$ StartStopContinue
StartStopContinueStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = StartStopContinue -> XParse StartStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopContinue -> XParse StartStopContinue)
-> StartStopContinue -> XParse StartStopContinue
forall a b. (a -> b) -> a -> b
$ StartStopContinue
StartStopContinueContinue
        | Bool
otherwise = String -> XParse StartStopContinue
forall a. String -> XParse a
P.xfail (String -> XParse StartStopContinue)
-> String -> XParse StartStopContinue
forall a b. (a -> b) -> a -> b
$ String
"StartStopContinue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @start-stop-discontinue@ /(simple)/
--
-- The start-stop-discontinue type is used to specify ending types. Typically, the start type is associated with the left barline of the first measure in an ending. The stop and discontinue types are associated with the right barline of the last measure in an ending. Stop is used when the ending mark concludes with a downward jog, as is typical for first endings. Discontinue is used when there is no downward jog, as is typical for second endings that do not conclude a piece.
data StartStopDiscontinue = 
      StartStopDiscontinueStart -- ^ /start/
    | StartStopDiscontinueStop -- ^ /stop/
    | StartStopDiscontinueDiscontinue -- ^ /discontinue/
    deriving (StartStopDiscontinue -> StartStopDiscontinue -> Bool
(StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> (StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> Eq StartStopDiscontinue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c/= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
== :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c== :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
Eq,Typeable,(forall x. StartStopDiscontinue -> Rep StartStopDiscontinue x)
-> (forall x. Rep StartStopDiscontinue x -> StartStopDiscontinue)
-> Generic StartStopDiscontinue
forall x. Rep StartStopDiscontinue x -> StartStopDiscontinue
forall x. StartStopDiscontinue -> Rep StartStopDiscontinue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartStopDiscontinue x -> StartStopDiscontinue
$cfrom :: forall x. StartStopDiscontinue -> Rep StartStopDiscontinue x
Generic,Int -> StartStopDiscontinue -> ShowS
[StartStopDiscontinue] -> ShowS
StartStopDiscontinue -> String
(Int -> StartStopDiscontinue -> ShowS)
-> (StartStopDiscontinue -> String)
-> ([StartStopDiscontinue] -> ShowS)
-> Show StartStopDiscontinue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStopDiscontinue] -> ShowS
$cshowList :: [StartStopDiscontinue] -> ShowS
show :: StartStopDiscontinue -> String
$cshow :: StartStopDiscontinue -> String
showsPrec :: Int -> StartStopDiscontinue -> ShowS
$cshowsPrec :: Int -> StartStopDiscontinue -> ShowS
Show,Eq StartStopDiscontinue
Eq StartStopDiscontinue
-> (StartStopDiscontinue -> StartStopDiscontinue -> Ordering)
-> (StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> (StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> (StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> (StartStopDiscontinue -> StartStopDiscontinue -> Bool)
-> (StartStopDiscontinue
    -> StartStopDiscontinue -> StartStopDiscontinue)
-> (StartStopDiscontinue
    -> StartStopDiscontinue -> StartStopDiscontinue)
-> Ord StartStopDiscontinue
StartStopDiscontinue -> StartStopDiscontinue -> Bool
StartStopDiscontinue -> StartStopDiscontinue -> Ordering
StartStopDiscontinue
-> StartStopDiscontinue -> StartStopDiscontinue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartStopDiscontinue
-> StartStopDiscontinue -> StartStopDiscontinue
$cmin :: StartStopDiscontinue
-> StartStopDiscontinue -> StartStopDiscontinue
max :: StartStopDiscontinue
-> StartStopDiscontinue -> StartStopDiscontinue
$cmax :: StartStopDiscontinue
-> StartStopDiscontinue -> StartStopDiscontinue
>= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c>= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
> :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c> :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
<= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c<= :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
< :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
$c< :: StartStopDiscontinue -> StartStopDiscontinue -> Bool
compare :: StartStopDiscontinue -> StartStopDiscontinue -> Ordering
$ccompare :: StartStopDiscontinue -> StartStopDiscontinue -> Ordering
$cp1Ord :: Eq StartStopDiscontinue
Ord,Int -> StartStopDiscontinue
StartStopDiscontinue -> Int
StartStopDiscontinue -> [StartStopDiscontinue]
StartStopDiscontinue -> StartStopDiscontinue
StartStopDiscontinue
-> StartStopDiscontinue -> [StartStopDiscontinue]
StartStopDiscontinue
-> StartStopDiscontinue
-> StartStopDiscontinue
-> [StartStopDiscontinue]
(StartStopDiscontinue -> StartStopDiscontinue)
-> (StartStopDiscontinue -> StartStopDiscontinue)
-> (Int -> StartStopDiscontinue)
-> (StartStopDiscontinue -> Int)
-> (StartStopDiscontinue -> [StartStopDiscontinue])
-> (StartStopDiscontinue
    -> StartStopDiscontinue -> [StartStopDiscontinue])
-> (StartStopDiscontinue
    -> StartStopDiscontinue -> [StartStopDiscontinue])
-> (StartStopDiscontinue
    -> StartStopDiscontinue
    -> StartStopDiscontinue
    -> [StartStopDiscontinue])
-> Enum StartStopDiscontinue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartStopDiscontinue
-> StartStopDiscontinue
-> StartStopDiscontinue
-> [StartStopDiscontinue]
$cenumFromThenTo :: StartStopDiscontinue
-> StartStopDiscontinue
-> StartStopDiscontinue
-> [StartStopDiscontinue]
enumFromTo :: StartStopDiscontinue
-> StartStopDiscontinue -> [StartStopDiscontinue]
$cenumFromTo :: StartStopDiscontinue
-> StartStopDiscontinue -> [StartStopDiscontinue]
enumFromThen :: StartStopDiscontinue
-> StartStopDiscontinue -> [StartStopDiscontinue]
$cenumFromThen :: StartStopDiscontinue
-> StartStopDiscontinue -> [StartStopDiscontinue]
enumFrom :: StartStopDiscontinue -> [StartStopDiscontinue]
$cenumFrom :: StartStopDiscontinue -> [StartStopDiscontinue]
fromEnum :: StartStopDiscontinue -> Int
$cfromEnum :: StartStopDiscontinue -> Int
toEnum :: Int -> StartStopDiscontinue
$ctoEnum :: Int -> StartStopDiscontinue
pred :: StartStopDiscontinue -> StartStopDiscontinue
$cpred :: StartStopDiscontinue -> StartStopDiscontinue
succ :: StartStopDiscontinue -> StartStopDiscontinue
$csucc :: StartStopDiscontinue -> StartStopDiscontinue
Enum,StartStopDiscontinue
StartStopDiscontinue
-> StartStopDiscontinue -> Bounded StartStopDiscontinue
forall a. a -> a -> Bounded a
maxBound :: StartStopDiscontinue
$cmaxBound :: StartStopDiscontinue
minBound :: StartStopDiscontinue
$cminBound :: StartStopDiscontinue
Bounded)
instance EmitXml StartStopDiscontinue where
    emitXml :: StartStopDiscontinue -> XmlRep
emitXml StartStopDiscontinue
StartStopDiscontinueStart = String -> XmlRep
XLit String
"start"
    emitXml StartStopDiscontinue
StartStopDiscontinueStop = String -> XmlRep
XLit String
"stop"
    emitXml StartStopDiscontinue
StartStopDiscontinueDiscontinue = String -> XmlRep
XLit String
"discontinue"
parseStartStopDiscontinue :: String -> P.XParse StartStopDiscontinue
parseStartStopDiscontinue :: String -> XParse StartStopDiscontinue
parseStartStopDiscontinue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = StartStopDiscontinue -> XParse StartStopDiscontinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopDiscontinue -> XParse StartStopDiscontinue)
-> StartStopDiscontinue -> XParse StartStopDiscontinue
forall a b. (a -> b) -> a -> b
$ StartStopDiscontinue
StartStopDiscontinueStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = StartStopDiscontinue -> XParse StartStopDiscontinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopDiscontinue -> XParse StartStopDiscontinue)
-> StartStopDiscontinue -> XParse StartStopDiscontinue
forall a b. (a -> b) -> a -> b
$ StartStopDiscontinue
StartStopDiscontinueStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"discontinue" = StartStopDiscontinue -> XParse StartStopDiscontinue
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopDiscontinue -> XParse StartStopDiscontinue)
-> StartStopDiscontinue -> XParse StartStopDiscontinue
forall a b. (a -> b) -> a -> b
$ StartStopDiscontinue
StartStopDiscontinueDiscontinue
        | Bool
otherwise = String -> XParse StartStopDiscontinue
forall a. String -> XParse a
P.xfail (String -> XParse StartStopDiscontinue)
-> String -> XParse StartStopDiscontinue
forall a b. (a -> b) -> a -> b
$ String
"StartStopDiscontinue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @start-stop-single@ /(simple)/
--
-- The start-stop-single type is used for an attribute of musical elements that can be used for either multi-note or single-note musical elements, as for groupings.
data StartStopSingle = 
      StartStopSingleStart -- ^ /start/
    | StartStopSingleStop -- ^ /stop/
    | StartStopSingleSingle -- ^ /single/
    deriving (StartStopSingle -> StartStopSingle -> Bool
(StartStopSingle -> StartStopSingle -> Bool)
-> (StartStopSingle -> StartStopSingle -> Bool)
-> Eq StartStopSingle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartStopSingle -> StartStopSingle -> Bool
$c/= :: StartStopSingle -> StartStopSingle -> Bool
== :: StartStopSingle -> StartStopSingle -> Bool
$c== :: StartStopSingle -> StartStopSingle -> Bool
Eq,Typeable,(forall x. StartStopSingle -> Rep StartStopSingle x)
-> (forall x. Rep StartStopSingle x -> StartStopSingle)
-> Generic StartStopSingle
forall x. Rep StartStopSingle x -> StartStopSingle
forall x. StartStopSingle -> Rep StartStopSingle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartStopSingle x -> StartStopSingle
$cfrom :: forall x. StartStopSingle -> Rep StartStopSingle x
Generic,Int -> StartStopSingle -> ShowS
[StartStopSingle] -> ShowS
StartStopSingle -> String
(Int -> StartStopSingle -> ShowS)
-> (StartStopSingle -> String)
-> ([StartStopSingle] -> ShowS)
-> Show StartStopSingle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartStopSingle] -> ShowS
$cshowList :: [StartStopSingle] -> ShowS
show :: StartStopSingle -> String
$cshow :: StartStopSingle -> String
showsPrec :: Int -> StartStopSingle -> ShowS
$cshowsPrec :: Int -> StartStopSingle -> ShowS
Show,Eq StartStopSingle
Eq StartStopSingle
-> (StartStopSingle -> StartStopSingle -> Ordering)
-> (StartStopSingle -> StartStopSingle -> Bool)
-> (StartStopSingle -> StartStopSingle -> Bool)
-> (StartStopSingle -> StartStopSingle -> Bool)
-> (StartStopSingle -> StartStopSingle -> Bool)
-> (StartStopSingle -> StartStopSingle -> StartStopSingle)
-> (StartStopSingle -> StartStopSingle -> StartStopSingle)
-> Ord StartStopSingle
StartStopSingle -> StartStopSingle -> Bool
StartStopSingle -> StartStopSingle -> Ordering
StartStopSingle -> StartStopSingle -> StartStopSingle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartStopSingle -> StartStopSingle -> StartStopSingle
$cmin :: StartStopSingle -> StartStopSingle -> StartStopSingle
max :: StartStopSingle -> StartStopSingle -> StartStopSingle
$cmax :: StartStopSingle -> StartStopSingle -> StartStopSingle
>= :: StartStopSingle -> StartStopSingle -> Bool
$c>= :: StartStopSingle -> StartStopSingle -> Bool
> :: StartStopSingle -> StartStopSingle -> Bool
$c> :: StartStopSingle -> StartStopSingle -> Bool
<= :: StartStopSingle -> StartStopSingle -> Bool
$c<= :: StartStopSingle -> StartStopSingle -> Bool
< :: StartStopSingle -> StartStopSingle -> Bool
$c< :: StartStopSingle -> StartStopSingle -> Bool
compare :: StartStopSingle -> StartStopSingle -> Ordering
$ccompare :: StartStopSingle -> StartStopSingle -> Ordering
$cp1Ord :: Eq StartStopSingle
Ord,Int -> StartStopSingle
StartStopSingle -> Int
StartStopSingle -> [StartStopSingle]
StartStopSingle -> StartStopSingle
StartStopSingle -> StartStopSingle -> [StartStopSingle]
StartStopSingle
-> StartStopSingle -> StartStopSingle -> [StartStopSingle]
(StartStopSingle -> StartStopSingle)
-> (StartStopSingle -> StartStopSingle)
-> (Int -> StartStopSingle)
-> (StartStopSingle -> Int)
-> (StartStopSingle -> [StartStopSingle])
-> (StartStopSingle -> StartStopSingle -> [StartStopSingle])
-> (StartStopSingle -> StartStopSingle -> [StartStopSingle])
-> (StartStopSingle
    -> StartStopSingle -> StartStopSingle -> [StartStopSingle])
-> Enum StartStopSingle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StartStopSingle
-> StartStopSingle -> StartStopSingle -> [StartStopSingle]
$cenumFromThenTo :: StartStopSingle
-> StartStopSingle -> StartStopSingle -> [StartStopSingle]
enumFromTo :: StartStopSingle -> StartStopSingle -> [StartStopSingle]
$cenumFromTo :: StartStopSingle -> StartStopSingle -> [StartStopSingle]
enumFromThen :: StartStopSingle -> StartStopSingle -> [StartStopSingle]
$cenumFromThen :: StartStopSingle -> StartStopSingle -> [StartStopSingle]
enumFrom :: StartStopSingle -> [StartStopSingle]
$cenumFrom :: StartStopSingle -> [StartStopSingle]
fromEnum :: StartStopSingle -> Int
$cfromEnum :: StartStopSingle -> Int
toEnum :: Int -> StartStopSingle
$ctoEnum :: Int -> StartStopSingle
pred :: StartStopSingle -> StartStopSingle
$cpred :: StartStopSingle -> StartStopSingle
succ :: StartStopSingle -> StartStopSingle
$csucc :: StartStopSingle -> StartStopSingle
Enum,StartStopSingle
StartStopSingle -> StartStopSingle -> Bounded StartStopSingle
forall a. a -> a -> Bounded a
maxBound :: StartStopSingle
$cmaxBound :: StartStopSingle
minBound :: StartStopSingle
$cminBound :: StartStopSingle
Bounded)
instance EmitXml StartStopSingle where
    emitXml :: StartStopSingle -> XmlRep
emitXml StartStopSingle
StartStopSingleStart = String -> XmlRep
XLit String
"start"
    emitXml StartStopSingle
StartStopSingleStop = String -> XmlRep
XLit String
"stop"
    emitXml StartStopSingle
StartStopSingleSingle = String -> XmlRep
XLit String
"single"
parseStartStopSingle :: String -> P.XParse StartStopSingle
parseStartStopSingle :: String -> XParse StartStopSingle
parseStartStopSingle String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = StartStopSingle -> XParse StartStopSingle
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopSingle -> XParse StartStopSingle)
-> StartStopSingle -> XParse StartStopSingle
forall a b. (a -> b) -> a -> b
$ StartStopSingle
StartStopSingleStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = StartStopSingle -> XParse StartStopSingle
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopSingle -> XParse StartStopSingle)
-> StartStopSingle -> XParse StartStopSingle
forall a b. (a -> b) -> a -> b
$ StartStopSingle
StartStopSingleStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single" = StartStopSingle -> XParse StartStopSingle
forall (m :: * -> *) a. Monad m => a -> m a
return (StartStopSingle -> XParse StartStopSingle)
-> StartStopSingle -> XParse StartStopSingle
forall a b. (a -> b) -> a -> b
$ StartStopSingle
StartStopSingleSingle
        | Bool
otherwise = String -> XParse StartStopSingle
forall a. String -> XParse a
P.xfail (String -> XParse StartStopSingle)
-> String -> XParse StartStopSingle
forall a b. (a -> b) -> a -> b
$ String
"StartStopSingle: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @stem-value@ /(simple)/
--
-- The stem type represents the notated stem direction.
data StemValue = 
      StemValueDown -- ^ /down/
    | StemValueUp -- ^ /up/
    | StemValueDouble -- ^ /double/
    | StemValueNone -- ^ /none/
    deriving (StemValue -> StemValue -> Bool
(StemValue -> StemValue -> Bool)
-> (StemValue -> StemValue -> Bool) -> Eq StemValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StemValue -> StemValue -> Bool
$c/= :: StemValue -> StemValue -> Bool
== :: StemValue -> StemValue -> Bool
$c== :: StemValue -> StemValue -> Bool
Eq,Typeable,(forall x. StemValue -> Rep StemValue x)
-> (forall x. Rep StemValue x -> StemValue) -> Generic StemValue
forall x. Rep StemValue x -> StemValue
forall x. StemValue -> Rep StemValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StemValue x -> StemValue
$cfrom :: forall x. StemValue -> Rep StemValue x
Generic,Int -> StemValue -> ShowS
[StemValue] -> ShowS
StemValue -> String
(Int -> StemValue -> ShowS)
-> (StemValue -> String)
-> ([StemValue] -> ShowS)
-> Show StemValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StemValue] -> ShowS
$cshowList :: [StemValue] -> ShowS
show :: StemValue -> String
$cshow :: StemValue -> String
showsPrec :: Int -> StemValue -> ShowS
$cshowsPrec :: Int -> StemValue -> ShowS
Show,Eq StemValue
Eq StemValue
-> (StemValue -> StemValue -> Ordering)
-> (StemValue -> StemValue -> Bool)
-> (StemValue -> StemValue -> Bool)
-> (StemValue -> StemValue -> Bool)
-> (StemValue -> StemValue -> Bool)
-> (StemValue -> StemValue -> StemValue)
-> (StemValue -> StemValue -> StemValue)
-> Ord StemValue
StemValue -> StemValue -> Bool
StemValue -> StemValue -> Ordering
StemValue -> StemValue -> StemValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StemValue -> StemValue -> StemValue
$cmin :: StemValue -> StemValue -> StemValue
max :: StemValue -> StemValue -> StemValue
$cmax :: StemValue -> StemValue -> StemValue
>= :: StemValue -> StemValue -> Bool
$c>= :: StemValue -> StemValue -> Bool
> :: StemValue -> StemValue -> Bool
$c> :: StemValue -> StemValue -> Bool
<= :: StemValue -> StemValue -> Bool
$c<= :: StemValue -> StemValue -> Bool
< :: StemValue -> StemValue -> Bool
$c< :: StemValue -> StemValue -> Bool
compare :: StemValue -> StemValue -> Ordering
$ccompare :: StemValue -> StemValue -> Ordering
$cp1Ord :: Eq StemValue
Ord,Int -> StemValue
StemValue -> Int
StemValue -> [StemValue]
StemValue -> StemValue
StemValue -> StemValue -> [StemValue]
StemValue -> StemValue -> StemValue -> [StemValue]
(StemValue -> StemValue)
-> (StemValue -> StemValue)
-> (Int -> StemValue)
-> (StemValue -> Int)
-> (StemValue -> [StemValue])
-> (StemValue -> StemValue -> [StemValue])
-> (StemValue -> StemValue -> [StemValue])
-> (StemValue -> StemValue -> StemValue -> [StemValue])
-> Enum StemValue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StemValue -> StemValue -> StemValue -> [StemValue]
$cenumFromThenTo :: StemValue -> StemValue -> StemValue -> [StemValue]
enumFromTo :: StemValue -> StemValue -> [StemValue]
$cenumFromTo :: StemValue -> StemValue -> [StemValue]
enumFromThen :: StemValue -> StemValue -> [StemValue]
$cenumFromThen :: StemValue -> StemValue -> [StemValue]
enumFrom :: StemValue -> [StemValue]
$cenumFrom :: StemValue -> [StemValue]
fromEnum :: StemValue -> Int
$cfromEnum :: StemValue -> Int
toEnum :: Int -> StemValue
$ctoEnum :: Int -> StemValue
pred :: StemValue -> StemValue
$cpred :: StemValue -> StemValue
succ :: StemValue -> StemValue
$csucc :: StemValue -> StemValue
Enum,StemValue
StemValue -> StemValue -> Bounded StemValue
forall a. a -> a -> Bounded a
maxBound :: StemValue
$cmaxBound :: StemValue
minBound :: StemValue
$cminBound :: StemValue
Bounded)
instance EmitXml StemValue where
    emitXml :: StemValue -> XmlRep
emitXml StemValue
StemValueDown = String -> XmlRep
XLit String
"down"
    emitXml StemValue
StemValueUp = String -> XmlRep
XLit String
"up"
    emitXml StemValue
StemValueDouble = String -> XmlRep
XLit String
"double"
    emitXml StemValue
StemValueNone = String -> XmlRep
XLit String
"none"
parseStemValue :: String -> P.XParse StemValue
parseStemValue :: String -> XParse StemValue
parseStemValue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = StemValue -> XParse StemValue
forall (m :: * -> *) a. Monad m => a -> m a
return (StemValue -> XParse StemValue) -> StemValue -> XParse StemValue
forall a b. (a -> b) -> a -> b
$ StemValue
StemValueDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = StemValue -> XParse StemValue
forall (m :: * -> *) a. Monad m => a -> m a
return (StemValue -> XParse StemValue) -> StemValue -> XParse StemValue
forall a b. (a -> b) -> a -> b
$ StemValue
StemValueUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double" = StemValue -> XParse StemValue
forall (m :: * -> *) a. Monad m => a -> m a
return (StemValue -> XParse StemValue) -> StemValue -> XParse StemValue
forall a b. (a -> b) -> a -> b
$ StemValue
StemValueDouble
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = StemValue -> XParse StemValue
forall (m :: * -> *) a. Monad m => a -> m a
return (StemValue -> XParse StemValue) -> StemValue -> XParse StemValue
forall a b. (a -> b) -> a -> b
$ StemValue
StemValueNone
        | Bool
otherwise = String -> XParse StemValue
forall a. String -> XParse a
P.xfail (String -> XParse StemValue) -> String -> XParse StemValue
forall a b. (a -> b) -> a -> b
$ String
"StemValue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @step@ /(simple)/
--
-- The step type represents a step of the diatonic scale, represented using the English letters A through G.
data Step = 
      StepA -- ^ /A/
    | StepB -- ^ /B/
    | StepC -- ^ /C/
    | StepD -- ^ /D/
    | StepE -- ^ /E/
    | StepF -- ^ /F/
    | StepG -- ^ /G/
    deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq,Typeable,(forall x. Step -> Rep Step x)
-> (forall x. Rep Step x -> Step) -> Generic Step
forall x. Rep Step x -> Step
forall x. Step -> Rep Step x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Step x -> Step
$cfrom :: forall x. Step -> Rep Step x
Generic,Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show,Eq Step
Eq Step
-> (Step -> Step -> Ordering)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Bool)
-> (Step -> Step -> Step)
-> (Step -> Step -> Step)
-> Ord Step
Step -> Step -> Bool
Step -> Step -> Ordering
Step -> Step -> Step
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Step -> Step -> Step
$cmin :: Step -> Step -> Step
max :: Step -> Step -> Step
$cmax :: Step -> Step -> Step
>= :: Step -> Step -> Bool
$c>= :: Step -> Step -> Bool
> :: Step -> Step -> Bool
$c> :: Step -> Step -> Bool
<= :: Step -> Step -> Bool
$c<= :: Step -> Step -> Bool
< :: Step -> Step -> Bool
$c< :: Step -> Step -> Bool
compare :: Step -> Step -> Ordering
$ccompare :: Step -> Step -> Ordering
$cp1Ord :: Eq Step
Ord,Int -> Step
Step -> Int
Step -> [Step]
Step -> Step
Step -> Step -> [Step]
Step -> Step -> Step -> [Step]
(Step -> Step)
-> (Step -> Step)
-> (Int -> Step)
-> (Step -> Int)
-> (Step -> [Step])
-> (Step -> Step -> [Step])
-> (Step -> Step -> [Step])
-> (Step -> Step -> Step -> [Step])
-> Enum Step
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Step -> Step -> Step -> [Step]
$cenumFromThenTo :: Step -> Step -> Step -> [Step]
enumFromTo :: Step -> Step -> [Step]
$cenumFromTo :: Step -> Step -> [Step]
enumFromThen :: Step -> Step -> [Step]
$cenumFromThen :: Step -> Step -> [Step]
enumFrom :: Step -> [Step]
$cenumFrom :: Step -> [Step]
fromEnum :: Step -> Int
$cfromEnum :: Step -> Int
toEnum :: Int -> Step
$ctoEnum :: Int -> Step
pred :: Step -> Step
$cpred :: Step -> Step
succ :: Step -> Step
$csucc :: Step -> Step
Enum,Step
Step -> Step -> Bounded Step
forall a. a -> a -> Bounded a
maxBound :: Step
$cmaxBound :: Step
minBound :: Step
$cminBound :: Step
Bounded)
instance EmitXml Step where
    emitXml :: Step -> XmlRep
emitXml Step
StepA = String -> XmlRep
XLit String
"A"
    emitXml Step
StepB = String -> XmlRep
XLit String
"B"
    emitXml Step
StepC = String -> XmlRep
XLit String
"C"
    emitXml Step
StepD = String -> XmlRep
XLit String
"D"
    emitXml Step
StepE = String -> XmlRep
XLit String
"E"
    emitXml Step
StepF = String -> XmlRep
XLit String
"F"
    emitXml Step
StepG = String -> XmlRep
XLit String
"G"
parseStep :: String -> P.XParse Step
parseStep :: String -> XParse Step
parseStep String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"A" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepA
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"B" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepB
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"C" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepC
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"D" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepD
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"E" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepE
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"F" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepF
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"G" = Step -> XParse Step
forall (m :: * -> *) a. Monad m => a -> m a
return (Step -> XParse Step) -> Step -> XParse Step
forall a b. (a -> b) -> a -> b
$ Step
StepG
        | Bool
otherwise = String -> XParse Step
forall a. String -> XParse a
P.xfail (String -> XParse Step) -> String -> XParse Step
forall a b. (a -> b) -> a -> b
$ String
"Step: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @stick-location@ /(simple)/
--
-- The stick-location type represents pictograms for the location of sticks, beaters, or mallets on cymbals, gongs, drums, and other instruments.
data StickLocation = 
      StickLocationCenter -- ^ /center/
    | StickLocationRim -- ^ /rim/
    | StickLocationCymbalBell -- ^ /cymbal bell/
    | StickLocationCymbalEdge -- ^ /cymbal edge/
    deriving (StickLocation -> StickLocation -> Bool
(StickLocation -> StickLocation -> Bool)
-> (StickLocation -> StickLocation -> Bool) -> Eq StickLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickLocation -> StickLocation -> Bool
$c/= :: StickLocation -> StickLocation -> Bool
== :: StickLocation -> StickLocation -> Bool
$c== :: StickLocation -> StickLocation -> Bool
Eq,Typeable,(forall x. StickLocation -> Rep StickLocation x)
-> (forall x. Rep StickLocation x -> StickLocation)
-> Generic StickLocation
forall x. Rep StickLocation x -> StickLocation
forall x. StickLocation -> Rep StickLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickLocation x -> StickLocation
$cfrom :: forall x. StickLocation -> Rep StickLocation x
Generic,Int -> StickLocation -> ShowS
[StickLocation] -> ShowS
StickLocation -> String
(Int -> StickLocation -> ShowS)
-> (StickLocation -> String)
-> ([StickLocation] -> ShowS)
-> Show StickLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickLocation] -> ShowS
$cshowList :: [StickLocation] -> ShowS
show :: StickLocation -> String
$cshow :: StickLocation -> String
showsPrec :: Int -> StickLocation -> ShowS
$cshowsPrec :: Int -> StickLocation -> ShowS
Show,Eq StickLocation
Eq StickLocation
-> (StickLocation -> StickLocation -> Ordering)
-> (StickLocation -> StickLocation -> Bool)
-> (StickLocation -> StickLocation -> Bool)
-> (StickLocation -> StickLocation -> Bool)
-> (StickLocation -> StickLocation -> Bool)
-> (StickLocation -> StickLocation -> StickLocation)
-> (StickLocation -> StickLocation -> StickLocation)
-> Ord StickLocation
StickLocation -> StickLocation -> Bool
StickLocation -> StickLocation -> Ordering
StickLocation -> StickLocation -> StickLocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickLocation -> StickLocation -> StickLocation
$cmin :: StickLocation -> StickLocation -> StickLocation
max :: StickLocation -> StickLocation -> StickLocation
$cmax :: StickLocation -> StickLocation -> StickLocation
>= :: StickLocation -> StickLocation -> Bool
$c>= :: StickLocation -> StickLocation -> Bool
> :: StickLocation -> StickLocation -> Bool
$c> :: StickLocation -> StickLocation -> Bool
<= :: StickLocation -> StickLocation -> Bool
$c<= :: StickLocation -> StickLocation -> Bool
< :: StickLocation -> StickLocation -> Bool
$c< :: StickLocation -> StickLocation -> Bool
compare :: StickLocation -> StickLocation -> Ordering
$ccompare :: StickLocation -> StickLocation -> Ordering
$cp1Ord :: Eq StickLocation
Ord,Int -> StickLocation
StickLocation -> Int
StickLocation -> [StickLocation]
StickLocation -> StickLocation
StickLocation -> StickLocation -> [StickLocation]
StickLocation -> StickLocation -> StickLocation -> [StickLocation]
(StickLocation -> StickLocation)
-> (StickLocation -> StickLocation)
-> (Int -> StickLocation)
-> (StickLocation -> Int)
-> (StickLocation -> [StickLocation])
-> (StickLocation -> StickLocation -> [StickLocation])
-> (StickLocation -> StickLocation -> [StickLocation])
-> (StickLocation
    -> StickLocation -> StickLocation -> [StickLocation])
-> Enum StickLocation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StickLocation -> StickLocation -> StickLocation -> [StickLocation]
$cenumFromThenTo :: StickLocation -> StickLocation -> StickLocation -> [StickLocation]
enumFromTo :: StickLocation -> StickLocation -> [StickLocation]
$cenumFromTo :: StickLocation -> StickLocation -> [StickLocation]
enumFromThen :: StickLocation -> StickLocation -> [StickLocation]
$cenumFromThen :: StickLocation -> StickLocation -> [StickLocation]
enumFrom :: StickLocation -> [StickLocation]
$cenumFrom :: StickLocation -> [StickLocation]
fromEnum :: StickLocation -> Int
$cfromEnum :: StickLocation -> Int
toEnum :: Int -> StickLocation
$ctoEnum :: Int -> StickLocation
pred :: StickLocation -> StickLocation
$cpred :: StickLocation -> StickLocation
succ :: StickLocation -> StickLocation
$csucc :: StickLocation -> StickLocation
Enum,StickLocation
StickLocation -> StickLocation -> Bounded StickLocation
forall a. a -> a -> Bounded a
maxBound :: StickLocation
$cmaxBound :: StickLocation
minBound :: StickLocation
$cminBound :: StickLocation
Bounded)
instance EmitXml StickLocation where
    emitXml :: StickLocation -> XmlRep
emitXml StickLocation
StickLocationCenter = String -> XmlRep
XLit String
"center"
    emitXml StickLocation
StickLocationRim = String -> XmlRep
XLit String
"rim"
    emitXml StickLocation
StickLocationCymbalBell = String -> XmlRep
XLit String
"cymbal bell"
    emitXml StickLocation
StickLocationCymbalEdge = String -> XmlRep
XLit String
"cymbal edge"
parseStickLocation :: String -> P.XParse StickLocation
parseStickLocation :: String -> XParse StickLocation
parseStickLocation String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"center" = StickLocation -> XParse StickLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (StickLocation -> XParse StickLocation)
-> StickLocation -> XParse StickLocation
forall a b. (a -> b) -> a -> b
$ StickLocation
StickLocationCenter
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rim" = StickLocation -> XParse StickLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (StickLocation -> XParse StickLocation)
-> StickLocation -> XParse StickLocation
forall a b. (a -> b) -> a -> b
$ StickLocation
StickLocationRim
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cymbal bell" = StickLocation -> XParse StickLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (StickLocation -> XParse StickLocation)
-> StickLocation -> XParse StickLocation
forall a b. (a -> b) -> a -> b
$ StickLocation
StickLocationCymbalBell
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cymbal edge" = StickLocation -> XParse StickLocation
forall (m :: * -> *) a. Monad m => a -> m a
return (StickLocation -> XParse StickLocation)
-> StickLocation -> XParse StickLocation
forall a b. (a -> b) -> a -> b
$ StickLocation
StickLocationCymbalEdge
        | Bool
otherwise = String -> XParse StickLocation
forall a. String -> XParse a
P.xfail (String -> XParse StickLocation) -> String -> XParse StickLocation
forall a b. (a -> b) -> a -> b
$ String
"StickLocation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @stick-material@ /(simple)/
--
-- The stick-material type represents the material being displayed in a stick pictogram.
data StickMaterial = 
      StickMaterialSoft -- ^ /soft/
    | StickMaterialMedium -- ^ /medium/
    | StickMaterialHard -- ^ /hard/
    | StickMaterialShaded -- ^ /shaded/
    | StickMaterialX -- ^ /x/
    deriving (StickMaterial -> StickMaterial -> Bool
(StickMaterial -> StickMaterial -> Bool)
-> (StickMaterial -> StickMaterial -> Bool) -> Eq StickMaterial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickMaterial -> StickMaterial -> Bool
$c/= :: StickMaterial -> StickMaterial -> Bool
== :: StickMaterial -> StickMaterial -> Bool
$c== :: StickMaterial -> StickMaterial -> Bool
Eq,Typeable,(forall x. StickMaterial -> Rep StickMaterial x)
-> (forall x. Rep StickMaterial x -> StickMaterial)
-> Generic StickMaterial
forall x. Rep StickMaterial x -> StickMaterial
forall x. StickMaterial -> Rep StickMaterial x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickMaterial x -> StickMaterial
$cfrom :: forall x. StickMaterial -> Rep StickMaterial x
Generic,Int -> StickMaterial -> ShowS
[StickMaterial] -> ShowS
StickMaterial -> String
(Int -> StickMaterial -> ShowS)
-> (StickMaterial -> String)
-> ([StickMaterial] -> ShowS)
-> Show StickMaterial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickMaterial] -> ShowS
$cshowList :: [StickMaterial] -> ShowS
show :: StickMaterial -> String
$cshow :: StickMaterial -> String
showsPrec :: Int -> StickMaterial -> ShowS
$cshowsPrec :: Int -> StickMaterial -> ShowS
Show,Eq StickMaterial
Eq StickMaterial
-> (StickMaterial -> StickMaterial -> Ordering)
-> (StickMaterial -> StickMaterial -> Bool)
-> (StickMaterial -> StickMaterial -> Bool)
-> (StickMaterial -> StickMaterial -> Bool)
-> (StickMaterial -> StickMaterial -> Bool)
-> (StickMaterial -> StickMaterial -> StickMaterial)
-> (StickMaterial -> StickMaterial -> StickMaterial)
-> Ord StickMaterial
StickMaterial -> StickMaterial -> Bool
StickMaterial -> StickMaterial -> Ordering
StickMaterial -> StickMaterial -> StickMaterial
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickMaterial -> StickMaterial -> StickMaterial
$cmin :: StickMaterial -> StickMaterial -> StickMaterial
max :: StickMaterial -> StickMaterial -> StickMaterial
$cmax :: StickMaterial -> StickMaterial -> StickMaterial
>= :: StickMaterial -> StickMaterial -> Bool
$c>= :: StickMaterial -> StickMaterial -> Bool
> :: StickMaterial -> StickMaterial -> Bool
$c> :: StickMaterial -> StickMaterial -> Bool
<= :: StickMaterial -> StickMaterial -> Bool
$c<= :: StickMaterial -> StickMaterial -> Bool
< :: StickMaterial -> StickMaterial -> Bool
$c< :: StickMaterial -> StickMaterial -> Bool
compare :: StickMaterial -> StickMaterial -> Ordering
$ccompare :: StickMaterial -> StickMaterial -> Ordering
$cp1Ord :: Eq StickMaterial
Ord,Int -> StickMaterial
StickMaterial -> Int
StickMaterial -> [StickMaterial]
StickMaterial -> StickMaterial
StickMaterial -> StickMaterial -> [StickMaterial]
StickMaterial -> StickMaterial -> StickMaterial -> [StickMaterial]
(StickMaterial -> StickMaterial)
-> (StickMaterial -> StickMaterial)
-> (Int -> StickMaterial)
-> (StickMaterial -> Int)
-> (StickMaterial -> [StickMaterial])
-> (StickMaterial -> StickMaterial -> [StickMaterial])
-> (StickMaterial -> StickMaterial -> [StickMaterial])
-> (StickMaterial
    -> StickMaterial -> StickMaterial -> [StickMaterial])
-> Enum StickMaterial
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StickMaterial -> StickMaterial -> StickMaterial -> [StickMaterial]
$cenumFromThenTo :: StickMaterial -> StickMaterial -> StickMaterial -> [StickMaterial]
enumFromTo :: StickMaterial -> StickMaterial -> [StickMaterial]
$cenumFromTo :: StickMaterial -> StickMaterial -> [StickMaterial]
enumFromThen :: StickMaterial -> StickMaterial -> [StickMaterial]
$cenumFromThen :: StickMaterial -> StickMaterial -> [StickMaterial]
enumFrom :: StickMaterial -> [StickMaterial]
$cenumFrom :: StickMaterial -> [StickMaterial]
fromEnum :: StickMaterial -> Int
$cfromEnum :: StickMaterial -> Int
toEnum :: Int -> StickMaterial
$ctoEnum :: Int -> StickMaterial
pred :: StickMaterial -> StickMaterial
$cpred :: StickMaterial -> StickMaterial
succ :: StickMaterial -> StickMaterial
$csucc :: StickMaterial -> StickMaterial
Enum,StickMaterial
StickMaterial -> StickMaterial -> Bounded StickMaterial
forall a. a -> a -> Bounded a
maxBound :: StickMaterial
$cmaxBound :: StickMaterial
minBound :: StickMaterial
$cminBound :: StickMaterial
Bounded)
instance EmitXml StickMaterial where
    emitXml :: StickMaterial -> XmlRep
emitXml StickMaterial
StickMaterialSoft = String -> XmlRep
XLit String
"soft"
    emitXml StickMaterial
StickMaterialMedium = String -> XmlRep
XLit String
"medium"
    emitXml StickMaterial
StickMaterialHard = String -> XmlRep
XLit String
"hard"
    emitXml StickMaterial
StickMaterialShaded = String -> XmlRep
XLit String
"shaded"
    emitXml StickMaterial
StickMaterialX = String -> XmlRep
XLit String
"x"
parseStickMaterial :: String -> P.XParse StickMaterial
parseStickMaterial :: String -> XParse StickMaterial
parseStickMaterial String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"soft" = StickMaterial -> XParse StickMaterial
forall (m :: * -> *) a. Monad m => a -> m a
return (StickMaterial -> XParse StickMaterial)
-> StickMaterial -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ StickMaterial
StickMaterialSoft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"medium" = StickMaterial -> XParse StickMaterial
forall (m :: * -> *) a. Monad m => a -> m a
return (StickMaterial -> XParse StickMaterial)
-> StickMaterial -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ StickMaterial
StickMaterialMedium
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hard" = StickMaterial -> XParse StickMaterial
forall (m :: * -> *) a. Monad m => a -> m a
return (StickMaterial -> XParse StickMaterial)
-> StickMaterial -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ StickMaterial
StickMaterialHard
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"shaded" = StickMaterial -> XParse StickMaterial
forall (m :: * -> *) a. Monad m => a -> m a
return (StickMaterial -> XParse StickMaterial)
-> StickMaterial -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ StickMaterial
StickMaterialShaded
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" = StickMaterial -> XParse StickMaterial
forall (m :: * -> *) a. Monad m => a -> m a
return (StickMaterial -> XParse StickMaterial)
-> StickMaterial -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ StickMaterial
StickMaterialX
        | Bool
otherwise = String -> XParse StickMaterial
forall a. String -> XParse a
P.xfail (String -> XParse StickMaterial) -> String -> XParse StickMaterial
forall a b. (a -> b) -> a -> b
$ String
"StickMaterial: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @stick-type@ /(simple)/
--
-- The stick-type type represents the shape of pictograms where the material
-- 	in the stick, mallet, or beater is represented in the pictogram.
data StickType = 
      StickTypeBassDrum -- ^ /bass drum/
    | StickTypeDoubleBassDrum -- ^ /double bass drum/
    | StickTypeGlockenspiel -- ^ /glockenspiel/
    | StickTypeGum -- ^ /gum/
    | StickTypeHammer -- ^ /hammer/
    | StickTypeSuperball -- ^ /superball/
    | StickTypeTimpani -- ^ /timpani/
    | StickTypeWound -- ^ /wound/
    | StickTypeXylophone -- ^ /xylophone/
    | StickTypeYarn -- ^ /yarn/
    deriving (StickType -> StickType -> Bool
(StickType -> StickType -> Bool)
-> (StickType -> StickType -> Bool) -> Eq StickType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickType -> StickType -> Bool
$c/= :: StickType -> StickType -> Bool
== :: StickType -> StickType -> Bool
$c== :: StickType -> StickType -> Bool
Eq,Typeable,(forall x. StickType -> Rep StickType x)
-> (forall x. Rep StickType x -> StickType) -> Generic StickType
forall x. Rep StickType x -> StickType
forall x. StickType -> Rep StickType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StickType x -> StickType
$cfrom :: forall x. StickType -> Rep StickType x
Generic,Int -> StickType -> ShowS
[StickType] -> ShowS
StickType -> String
(Int -> StickType -> ShowS)
-> (StickType -> String)
-> ([StickType] -> ShowS)
-> Show StickType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickType] -> ShowS
$cshowList :: [StickType] -> ShowS
show :: StickType -> String
$cshow :: StickType -> String
showsPrec :: Int -> StickType -> ShowS
$cshowsPrec :: Int -> StickType -> ShowS
Show,Eq StickType
Eq StickType
-> (StickType -> StickType -> Ordering)
-> (StickType -> StickType -> Bool)
-> (StickType -> StickType -> Bool)
-> (StickType -> StickType -> Bool)
-> (StickType -> StickType -> Bool)
-> (StickType -> StickType -> StickType)
-> (StickType -> StickType -> StickType)
-> Ord StickType
StickType -> StickType -> Bool
StickType -> StickType -> Ordering
StickType -> StickType -> StickType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StickType -> StickType -> StickType
$cmin :: StickType -> StickType -> StickType
max :: StickType -> StickType -> StickType
$cmax :: StickType -> StickType -> StickType
>= :: StickType -> StickType -> Bool
$c>= :: StickType -> StickType -> Bool
> :: StickType -> StickType -> Bool
$c> :: StickType -> StickType -> Bool
<= :: StickType -> StickType -> Bool
$c<= :: StickType -> StickType -> Bool
< :: StickType -> StickType -> Bool
$c< :: StickType -> StickType -> Bool
compare :: StickType -> StickType -> Ordering
$ccompare :: StickType -> StickType -> Ordering
$cp1Ord :: Eq StickType
Ord,Int -> StickType
StickType -> Int
StickType -> [StickType]
StickType -> StickType
StickType -> StickType -> [StickType]
StickType -> StickType -> StickType -> [StickType]
(StickType -> StickType)
-> (StickType -> StickType)
-> (Int -> StickType)
-> (StickType -> Int)
-> (StickType -> [StickType])
-> (StickType -> StickType -> [StickType])
-> (StickType -> StickType -> [StickType])
-> (StickType -> StickType -> StickType -> [StickType])
-> Enum StickType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StickType -> StickType -> StickType -> [StickType]
$cenumFromThenTo :: StickType -> StickType -> StickType -> [StickType]
enumFromTo :: StickType -> StickType -> [StickType]
$cenumFromTo :: StickType -> StickType -> [StickType]
enumFromThen :: StickType -> StickType -> [StickType]
$cenumFromThen :: StickType -> StickType -> [StickType]
enumFrom :: StickType -> [StickType]
$cenumFrom :: StickType -> [StickType]
fromEnum :: StickType -> Int
$cfromEnum :: StickType -> Int
toEnum :: Int -> StickType
$ctoEnum :: Int -> StickType
pred :: StickType -> StickType
$cpred :: StickType -> StickType
succ :: StickType -> StickType
$csucc :: StickType -> StickType
Enum,StickType
StickType -> StickType -> Bounded StickType
forall a. a -> a -> Bounded a
maxBound :: StickType
$cmaxBound :: StickType
minBound :: StickType
$cminBound :: StickType
Bounded)
instance EmitXml StickType where
    emitXml :: StickType -> XmlRep
emitXml StickType
StickTypeBassDrum = String -> XmlRep
XLit String
"bass drum"
    emitXml StickType
StickTypeDoubleBassDrum = String -> XmlRep
XLit String
"double bass drum"
    emitXml StickType
StickTypeGlockenspiel = String -> XmlRep
XLit String
"glockenspiel"
    emitXml StickType
StickTypeGum = String -> XmlRep
XLit String
"gum"
    emitXml StickType
StickTypeHammer = String -> XmlRep
XLit String
"hammer"
    emitXml StickType
StickTypeSuperball = String -> XmlRep
XLit String
"superball"
    emitXml StickType
StickTypeTimpani = String -> XmlRep
XLit String
"timpani"
    emitXml StickType
StickTypeWound = String -> XmlRep
XLit String
"wound"
    emitXml StickType
StickTypeXylophone = String -> XmlRep
XLit String
"xylophone"
    emitXml StickType
StickTypeYarn = String -> XmlRep
XLit String
"yarn"
parseStickType :: String -> P.XParse StickType
parseStickType :: String -> XParse StickType
parseStickType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bass drum" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeBassDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double bass drum" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeDoubleBassDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"glockenspiel" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeGlockenspiel
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"gum" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeGum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hammer" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeHammer
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"superball" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeSuperball
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"timpani" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeTimpani
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wound" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeWound
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xylophone" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeXylophone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yarn" = StickType -> XParse StickType
forall (m :: * -> *) a. Monad m => a -> m a
return (StickType -> XParse StickType) -> StickType -> XParse StickType
forall a b. (a -> b) -> a -> b
$ StickType
StickTypeYarn
        | Bool
otherwise = String -> XParse StickType
forall a. String -> XParse a
P.xfail (String -> XParse StickType) -> String -> XParse StickType
forall a b. (a -> b) -> a -> b
$ String
"StickType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @string-number@ /(simple)/
--
-- The string-number type indicates a string number. Strings are numbered from high to low, with 1 being the highest pitched full-length string.
newtype StringNumber = StringNumber { StringNumber -> PositiveInteger
stringNumber :: PositiveInteger }
    deriving (StringNumber -> StringNumber -> Bool
(StringNumber -> StringNumber -> Bool)
-> (StringNumber -> StringNumber -> Bool) -> Eq StringNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringNumber -> StringNumber -> Bool
$c/= :: StringNumber -> StringNumber -> Bool
== :: StringNumber -> StringNumber -> Bool
$c== :: StringNumber -> StringNumber -> Bool
Eq,Typeable,(forall x. StringNumber -> Rep StringNumber x)
-> (forall x. Rep StringNumber x -> StringNumber)
-> Generic StringNumber
forall x. Rep StringNumber x -> StringNumber
forall x. StringNumber -> Rep StringNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StringNumber x -> StringNumber
$cfrom :: forall x. StringNumber -> Rep StringNumber x
Generic,Eq StringNumber
Eq StringNumber
-> (StringNumber -> StringNumber -> Ordering)
-> (StringNumber -> StringNumber -> Bool)
-> (StringNumber -> StringNumber -> Bool)
-> (StringNumber -> StringNumber -> Bool)
-> (StringNumber -> StringNumber -> Bool)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> Ord StringNumber
StringNumber -> StringNumber -> Bool
StringNumber -> StringNumber -> Ordering
StringNumber -> StringNumber -> StringNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StringNumber -> StringNumber -> StringNumber
$cmin :: StringNumber -> StringNumber -> StringNumber
max :: StringNumber -> StringNumber -> StringNumber
$cmax :: StringNumber -> StringNumber -> StringNumber
>= :: StringNumber -> StringNumber -> Bool
$c>= :: StringNumber -> StringNumber -> Bool
> :: StringNumber -> StringNumber -> Bool
$c> :: StringNumber -> StringNumber -> Bool
<= :: StringNumber -> StringNumber -> Bool
$c<= :: StringNumber -> StringNumber -> Bool
< :: StringNumber -> StringNumber -> Bool
$c< :: StringNumber -> StringNumber -> Bool
compare :: StringNumber -> StringNumber -> Ordering
$ccompare :: StringNumber -> StringNumber -> Ordering
$cp1Ord :: Eq StringNumber
Ord,StringNumber
StringNumber -> StringNumber -> Bounded StringNumber
forall a. a -> a -> Bounded a
maxBound :: StringNumber
$cmaxBound :: StringNumber
minBound :: StringNumber
$cminBound :: StringNumber
Bounded,Int -> StringNumber
StringNumber -> Int
StringNumber -> [StringNumber]
StringNumber -> StringNumber
StringNumber -> StringNumber -> [StringNumber]
StringNumber -> StringNumber -> StringNumber -> [StringNumber]
(StringNumber -> StringNumber)
-> (StringNumber -> StringNumber)
-> (Int -> StringNumber)
-> (StringNumber -> Int)
-> (StringNumber -> [StringNumber])
-> (StringNumber -> StringNumber -> [StringNumber])
-> (StringNumber -> StringNumber -> [StringNumber])
-> (StringNumber -> StringNumber -> StringNumber -> [StringNumber])
-> Enum StringNumber
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StringNumber -> StringNumber -> StringNumber -> [StringNumber]
$cenumFromThenTo :: StringNumber -> StringNumber -> StringNumber -> [StringNumber]
enumFromTo :: StringNumber -> StringNumber -> [StringNumber]
$cenumFromTo :: StringNumber -> StringNumber -> [StringNumber]
enumFromThen :: StringNumber -> StringNumber -> [StringNumber]
$cenumFromThen :: StringNumber -> StringNumber -> [StringNumber]
enumFrom :: StringNumber -> [StringNumber]
$cenumFrom :: StringNumber -> [StringNumber]
fromEnum :: StringNumber -> Int
$cfromEnum :: StringNumber -> Int
toEnum :: Int -> StringNumber
$ctoEnum :: Int -> StringNumber
pred :: StringNumber -> StringNumber
$cpred :: StringNumber -> StringNumber
succ :: StringNumber -> StringNumber
$csucc :: StringNumber -> StringNumber
Enum,Integer -> StringNumber
StringNumber -> StringNumber
StringNumber -> StringNumber -> StringNumber
(StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber)
-> (StringNumber -> StringNumber)
-> (StringNumber -> StringNumber)
-> (Integer -> StringNumber)
-> Num StringNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> StringNumber
$cfromInteger :: Integer -> StringNumber
signum :: StringNumber -> StringNumber
$csignum :: StringNumber -> StringNumber
abs :: StringNumber -> StringNumber
$cabs :: StringNumber -> StringNumber
negate :: StringNumber -> StringNumber
$cnegate :: StringNumber -> StringNumber
* :: StringNumber -> StringNumber -> StringNumber
$c* :: StringNumber -> StringNumber -> StringNumber
- :: StringNumber -> StringNumber -> StringNumber
$c- :: StringNumber -> StringNumber -> StringNumber
+ :: StringNumber -> StringNumber -> StringNumber
$c+ :: StringNumber -> StringNumber -> StringNumber
Num,Num StringNumber
Ord StringNumber
Num StringNumber
-> Ord StringNumber
-> (StringNumber -> Rational)
-> Real StringNumber
StringNumber -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: StringNumber -> Rational
$ctoRational :: StringNumber -> Rational
$cp2Real :: Ord StringNumber
$cp1Real :: Num StringNumber
Real,Enum StringNumber
Real StringNumber
Real StringNumber
-> Enum StringNumber
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> StringNumber)
-> (StringNumber -> StringNumber -> (StringNumber, StringNumber))
-> (StringNumber -> StringNumber -> (StringNumber, StringNumber))
-> (StringNumber -> Integer)
-> Integral StringNumber
StringNumber -> Integer
StringNumber -> StringNumber -> (StringNumber, StringNumber)
StringNumber -> StringNumber -> StringNumber
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: StringNumber -> Integer
$ctoInteger :: StringNumber -> Integer
divMod :: StringNumber -> StringNumber -> (StringNumber, StringNumber)
$cdivMod :: StringNumber -> StringNumber -> (StringNumber, StringNumber)
quotRem :: StringNumber -> StringNumber -> (StringNumber, StringNumber)
$cquotRem :: StringNumber -> StringNumber -> (StringNumber, StringNumber)
mod :: StringNumber -> StringNumber -> StringNumber
$cmod :: StringNumber -> StringNumber -> StringNumber
div :: StringNumber -> StringNumber -> StringNumber
$cdiv :: StringNumber -> StringNumber -> StringNumber
rem :: StringNumber -> StringNumber -> StringNumber
$crem :: StringNumber -> StringNumber -> StringNumber
quot :: StringNumber -> StringNumber -> StringNumber
$cquot :: StringNumber -> StringNumber -> StringNumber
$cp2Integral :: Enum StringNumber
$cp1Integral :: Real StringNumber
Integral)
instance Show StringNumber where show :: StringNumber -> String
show (StringNumber PositiveInteger
a) = PositiveInteger -> String
forall a. Show a => a -> String
show PositiveInteger
a
instance Read StringNumber where readsPrec :: Int -> ReadS StringNumber
readsPrec Int
i = ((PositiveInteger, String) -> (StringNumber, String))
-> [(PositiveInteger, String)] -> [(StringNumber, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((PositiveInteger -> StringNumber)
-> (PositiveInteger, String) -> (StringNumber, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first PositiveInteger -> StringNumber
StringNumber) ([(PositiveInteger, String)] -> [(StringNumber, String)])
-> (String -> [(PositiveInteger, String)]) -> ReadS StringNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(PositiveInteger, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml StringNumber where
    emitXml :: StringNumber -> XmlRep
emitXml = PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (PositiveInteger -> XmlRep)
-> (StringNumber -> PositiveInteger) -> StringNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringNumber -> PositiveInteger
stringNumber
parseStringNumber :: String -> P.XParse StringNumber
parseStringNumber :: String -> XParse StringNumber
parseStringNumber = String -> String -> XParse StringNumber
forall a. Read a => String -> String -> XParse a
P.xread String
"StringNumber"

-- | @syllabic@ /(simple)/
--
-- Lyric hyphenation is indicated by the syllabic type. The single, begin, end, and middle values represent single-syllable words, word-beginning syllables, word-ending syllables, and mid-word syllables, respectively.
data Syllabic = 
      SyllabicSingle -- ^ /single/
    | SyllabicBegin -- ^ /begin/
    | SyllabicEnd -- ^ /end/
    | SyllabicMiddle -- ^ /middle/
    deriving (Syllabic -> Syllabic -> Bool
(Syllabic -> Syllabic -> Bool)
-> (Syllabic -> Syllabic -> Bool) -> Eq Syllabic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Syllabic -> Syllabic -> Bool
$c/= :: Syllabic -> Syllabic -> Bool
== :: Syllabic -> Syllabic -> Bool
$c== :: Syllabic -> Syllabic -> Bool
Eq,Typeable,(forall x. Syllabic -> Rep Syllabic x)
-> (forall x. Rep Syllabic x -> Syllabic) -> Generic Syllabic
forall x. Rep Syllabic x -> Syllabic
forall x. Syllabic -> Rep Syllabic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Syllabic x -> Syllabic
$cfrom :: forall x. Syllabic -> Rep Syllabic x
Generic,Int -> Syllabic -> ShowS
[Syllabic] -> ShowS
Syllabic -> String
(Int -> Syllabic -> ShowS)
-> (Syllabic -> String) -> ([Syllabic] -> ShowS) -> Show Syllabic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Syllabic] -> ShowS
$cshowList :: [Syllabic] -> ShowS
show :: Syllabic -> String
$cshow :: Syllabic -> String
showsPrec :: Int -> Syllabic -> ShowS
$cshowsPrec :: Int -> Syllabic -> ShowS
Show,Eq Syllabic
Eq Syllabic
-> (Syllabic -> Syllabic -> Ordering)
-> (Syllabic -> Syllabic -> Bool)
-> (Syllabic -> Syllabic -> Bool)
-> (Syllabic -> Syllabic -> Bool)
-> (Syllabic -> Syllabic -> Bool)
-> (Syllabic -> Syllabic -> Syllabic)
-> (Syllabic -> Syllabic -> Syllabic)
-> Ord Syllabic
Syllabic -> Syllabic -> Bool
Syllabic -> Syllabic -> Ordering
Syllabic -> Syllabic -> Syllabic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Syllabic -> Syllabic -> Syllabic
$cmin :: Syllabic -> Syllabic -> Syllabic
max :: Syllabic -> Syllabic -> Syllabic
$cmax :: Syllabic -> Syllabic -> Syllabic
>= :: Syllabic -> Syllabic -> Bool
$c>= :: Syllabic -> Syllabic -> Bool
> :: Syllabic -> Syllabic -> Bool
$c> :: Syllabic -> Syllabic -> Bool
<= :: Syllabic -> Syllabic -> Bool
$c<= :: Syllabic -> Syllabic -> Bool
< :: Syllabic -> Syllabic -> Bool
$c< :: Syllabic -> Syllabic -> Bool
compare :: Syllabic -> Syllabic -> Ordering
$ccompare :: Syllabic -> Syllabic -> Ordering
$cp1Ord :: Eq Syllabic
Ord,Int -> Syllabic
Syllabic -> Int
Syllabic -> [Syllabic]
Syllabic -> Syllabic
Syllabic -> Syllabic -> [Syllabic]
Syllabic -> Syllabic -> Syllabic -> [Syllabic]
(Syllabic -> Syllabic)
-> (Syllabic -> Syllabic)
-> (Int -> Syllabic)
-> (Syllabic -> Int)
-> (Syllabic -> [Syllabic])
-> (Syllabic -> Syllabic -> [Syllabic])
-> (Syllabic -> Syllabic -> [Syllabic])
-> (Syllabic -> Syllabic -> Syllabic -> [Syllabic])
-> Enum Syllabic
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Syllabic -> Syllabic -> Syllabic -> [Syllabic]
$cenumFromThenTo :: Syllabic -> Syllabic -> Syllabic -> [Syllabic]
enumFromTo :: Syllabic -> Syllabic -> [Syllabic]
$cenumFromTo :: Syllabic -> Syllabic -> [Syllabic]
enumFromThen :: Syllabic -> Syllabic -> [Syllabic]
$cenumFromThen :: Syllabic -> Syllabic -> [Syllabic]
enumFrom :: Syllabic -> [Syllabic]
$cenumFrom :: Syllabic -> [Syllabic]
fromEnum :: Syllabic -> Int
$cfromEnum :: Syllabic -> Int
toEnum :: Int -> Syllabic
$ctoEnum :: Int -> Syllabic
pred :: Syllabic -> Syllabic
$cpred :: Syllabic -> Syllabic
succ :: Syllabic -> Syllabic
$csucc :: Syllabic -> Syllabic
Enum,Syllabic
Syllabic -> Syllabic -> Bounded Syllabic
forall a. a -> a -> Bounded a
maxBound :: Syllabic
$cmaxBound :: Syllabic
minBound :: Syllabic
$cminBound :: Syllabic
Bounded)
instance EmitXml Syllabic where
    emitXml :: Syllabic -> XmlRep
emitXml Syllabic
SyllabicSingle = String -> XmlRep
XLit String
"single"
    emitXml Syllabic
SyllabicBegin = String -> XmlRep
XLit String
"begin"
    emitXml Syllabic
SyllabicEnd = String -> XmlRep
XLit String
"end"
    emitXml Syllabic
SyllabicMiddle = String -> XmlRep
XLit String
"middle"
parseSyllabic :: String -> P.XParse Syllabic
parseSyllabic :: String -> XParse Syllabic
parseSyllabic String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single" = Syllabic -> XParse Syllabic
forall (m :: * -> *) a. Monad m => a -> m a
return (Syllabic -> XParse Syllabic) -> Syllabic -> XParse Syllabic
forall a b. (a -> b) -> a -> b
$ Syllabic
SyllabicSingle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"begin" = Syllabic -> XParse Syllabic
forall (m :: * -> *) a. Monad m => a -> m a
return (Syllabic -> XParse Syllabic) -> Syllabic -> XParse Syllabic
forall a b. (a -> b) -> a -> b
$ Syllabic
SyllabicBegin
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"end" = Syllabic -> XParse Syllabic
forall (m :: * -> *) a. Monad m => a -> m a
return (Syllabic -> XParse Syllabic) -> Syllabic -> XParse Syllabic
forall a b. (a -> b) -> a -> b
$ Syllabic
SyllabicEnd
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"middle" = Syllabic -> XParse Syllabic
forall (m :: * -> *) a. Monad m => a -> m a
return (Syllabic -> XParse Syllabic) -> Syllabic -> XParse Syllabic
forall a b. (a -> b) -> a -> b
$ Syllabic
SyllabicMiddle
        | Bool
otherwise = String -> XParse Syllabic
forall a. String -> XParse a
P.xfail (String -> XParse Syllabic) -> String -> XParse Syllabic
forall a b. (a -> b) -> a -> b
$ String
"Syllabic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @symbol-size@ /(simple)/
--
-- The symbol-size type is used to distinguish between full, cue sized, grace cue sized, and oversized symbols.
data SymbolSize = 
      SymbolSizeFull -- ^ /full/
    | SymbolSizeCue -- ^ /cue/
    | SymbolSizeGraceCue -- ^ /grace-cue/
    | SymbolSizeLarge -- ^ /large/
    deriving (SymbolSize -> SymbolSize -> Bool
(SymbolSize -> SymbolSize -> Bool)
-> (SymbolSize -> SymbolSize -> Bool) -> Eq SymbolSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolSize -> SymbolSize -> Bool
$c/= :: SymbolSize -> SymbolSize -> Bool
== :: SymbolSize -> SymbolSize -> Bool
$c== :: SymbolSize -> SymbolSize -> Bool
Eq,Typeable,(forall x. SymbolSize -> Rep SymbolSize x)
-> (forall x. Rep SymbolSize x -> SymbolSize) -> Generic SymbolSize
forall x. Rep SymbolSize x -> SymbolSize
forall x. SymbolSize -> Rep SymbolSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SymbolSize x -> SymbolSize
$cfrom :: forall x. SymbolSize -> Rep SymbolSize x
Generic,Int -> SymbolSize -> ShowS
[SymbolSize] -> ShowS
SymbolSize -> String
(Int -> SymbolSize -> ShowS)
-> (SymbolSize -> String)
-> ([SymbolSize] -> ShowS)
-> Show SymbolSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolSize] -> ShowS
$cshowList :: [SymbolSize] -> ShowS
show :: SymbolSize -> String
$cshow :: SymbolSize -> String
showsPrec :: Int -> SymbolSize -> ShowS
$cshowsPrec :: Int -> SymbolSize -> ShowS
Show,Eq SymbolSize
Eq SymbolSize
-> (SymbolSize -> SymbolSize -> Ordering)
-> (SymbolSize -> SymbolSize -> Bool)
-> (SymbolSize -> SymbolSize -> Bool)
-> (SymbolSize -> SymbolSize -> Bool)
-> (SymbolSize -> SymbolSize -> Bool)
-> (SymbolSize -> SymbolSize -> SymbolSize)
-> (SymbolSize -> SymbolSize -> SymbolSize)
-> Ord SymbolSize
SymbolSize -> SymbolSize -> Bool
SymbolSize -> SymbolSize -> Ordering
SymbolSize -> SymbolSize -> SymbolSize
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymbolSize -> SymbolSize -> SymbolSize
$cmin :: SymbolSize -> SymbolSize -> SymbolSize
max :: SymbolSize -> SymbolSize -> SymbolSize
$cmax :: SymbolSize -> SymbolSize -> SymbolSize
>= :: SymbolSize -> SymbolSize -> Bool
$c>= :: SymbolSize -> SymbolSize -> Bool
> :: SymbolSize -> SymbolSize -> Bool
$c> :: SymbolSize -> SymbolSize -> Bool
<= :: SymbolSize -> SymbolSize -> Bool
$c<= :: SymbolSize -> SymbolSize -> Bool
< :: SymbolSize -> SymbolSize -> Bool
$c< :: SymbolSize -> SymbolSize -> Bool
compare :: SymbolSize -> SymbolSize -> Ordering
$ccompare :: SymbolSize -> SymbolSize -> Ordering
$cp1Ord :: Eq SymbolSize
Ord,Int -> SymbolSize
SymbolSize -> Int
SymbolSize -> [SymbolSize]
SymbolSize -> SymbolSize
SymbolSize -> SymbolSize -> [SymbolSize]
SymbolSize -> SymbolSize -> SymbolSize -> [SymbolSize]
(SymbolSize -> SymbolSize)
-> (SymbolSize -> SymbolSize)
-> (Int -> SymbolSize)
-> (SymbolSize -> Int)
-> (SymbolSize -> [SymbolSize])
-> (SymbolSize -> SymbolSize -> [SymbolSize])
-> (SymbolSize -> SymbolSize -> [SymbolSize])
-> (SymbolSize -> SymbolSize -> SymbolSize -> [SymbolSize])
-> Enum SymbolSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SymbolSize -> SymbolSize -> SymbolSize -> [SymbolSize]
$cenumFromThenTo :: SymbolSize -> SymbolSize -> SymbolSize -> [SymbolSize]
enumFromTo :: SymbolSize -> SymbolSize -> [SymbolSize]
$cenumFromTo :: SymbolSize -> SymbolSize -> [SymbolSize]
enumFromThen :: SymbolSize -> SymbolSize -> [SymbolSize]
$cenumFromThen :: SymbolSize -> SymbolSize -> [SymbolSize]
enumFrom :: SymbolSize -> [SymbolSize]
$cenumFrom :: SymbolSize -> [SymbolSize]
fromEnum :: SymbolSize -> Int
$cfromEnum :: SymbolSize -> Int
toEnum :: Int -> SymbolSize
$ctoEnum :: Int -> SymbolSize
pred :: SymbolSize -> SymbolSize
$cpred :: SymbolSize -> SymbolSize
succ :: SymbolSize -> SymbolSize
$csucc :: SymbolSize -> SymbolSize
Enum,SymbolSize
SymbolSize -> SymbolSize -> Bounded SymbolSize
forall a. a -> a -> Bounded a
maxBound :: SymbolSize
$cmaxBound :: SymbolSize
minBound :: SymbolSize
$cminBound :: SymbolSize
Bounded)
instance EmitXml SymbolSize where
    emitXml :: SymbolSize -> XmlRep
emitXml SymbolSize
SymbolSizeFull = String -> XmlRep
XLit String
"full"
    emitXml SymbolSize
SymbolSizeCue = String -> XmlRep
XLit String
"cue"
    emitXml SymbolSize
SymbolSizeGraceCue = String -> XmlRep
XLit String
"grace-cue"
    emitXml SymbolSize
SymbolSizeLarge = String -> XmlRep
XLit String
"large"
parseSymbolSize :: String -> P.XParse SymbolSize
parseSymbolSize :: String -> XParse SymbolSize
parseSymbolSize String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"full" = SymbolSize -> XParse SymbolSize
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolSize -> XParse SymbolSize)
-> SymbolSize -> XParse SymbolSize
forall a b. (a -> b) -> a -> b
$ SymbolSize
SymbolSizeFull
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cue" = SymbolSize -> XParse SymbolSize
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolSize -> XParse SymbolSize)
-> SymbolSize -> XParse SymbolSize
forall a b. (a -> b) -> a -> b
$ SymbolSize
SymbolSizeCue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"grace-cue" = SymbolSize -> XParse SymbolSize
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolSize -> XParse SymbolSize)
-> SymbolSize -> XParse SymbolSize
forall a b. (a -> b) -> a -> b
$ SymbolSize
SymbolSizeGraceCue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"large" = SymbolSize -> XParse SymbolSize
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolSize -> XParse SymbolSize)
-> SymbolSize -> XParse SymbolSize
forall a b. (a -> b) -> a -> b
$ SymbolSize
SymbolSizeLarge
        | Bool
otherwise = String -> XParse SymbolSize
forall a. String -> XParse a
P.xfail (String -> XParse SymbolSize) -> String -> XParse SymbolSize
forall a b. (a -> b) -> a -> b
$ String
"SymbolSize: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @tap-hand@ /(simple)/
--
-- The tap-hand type represents the symbol to use for a tap element. The left and right values refer to the SMuFL guitarLeftHandTapping and guitarRightHandTapping glyphs respectively.
data TapHand = 
      TapHandLeft -- ^ /left/
    | TapHandRight -- ^ /right/
    deriving (TapHand -> TapHand -> Bool
(TapHand -> TapHand -> Bool)
-> (TapHand -> TapHand -> Bool) -> Eq TapHand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TapHand -> TapHand -> Bool
$c/= :: TapHand -> TapHand -> Bool
== :: TapHand -> TapHand -> Bool
$c== :: TapHand -> TapHand -> Bool
Eq,Typeable,(forall x. TapHand -> Rep TapHand x)
-> (forall x. Rep TapHand x -> TapHand) -> Generic TapHand
forall x. Rep TapHand x -> TapHand
forall x. TapHand -> Rep TapHand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TapHand x -> TapHand
$cfrom :: forall x. TapHand -> Rep TapHand x
Generic,Int -> TapHand -> ShowS
[TapHand] -> ShowS
TapHand -> String
(Int -> TapHand -> ShowS)
-> (TapHand -> String) -> ([TapHand] -> ShowS) -> Show TapHand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TapHand] -> ShowS
$cshowList :: [TapHand] -> ShowS
show :: TapHand -> String
$cshow :: TapHand -> String
showsPrec :: Int -> TapHand -> ShowS
$cshowsPrec :: Int -> TapHand -> ShowS
Show,Eq TapHand
Eq TapHand
-> (TapHand -> TapHand -> Ordering)
-> (TapHand -> TapHand -> Bool)
-> (TapHand -> TapHand -> Bool)
-> (TapHand -> TapHand -> Bool)
-> (TapHand -> TapHand -> Bool)
-> (TapHand -> TapHand -> TapHand)
-> (TapHand -> TapHand -> TapHand)
-> Ord TapHand
TapHand -> TapHand -> Bool
TapHand -> TapHand -> Ordering
TapHand -> TapHand -> TapHand
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TapHand -> TapHand -> TapHand
$cmin :: TapHand -> TapHand -> TapHand
max :: TapHand -> TapHand -> TapHand
$cmax :: TapHand -> TapHand -> TapHand
>= :: TapHand -> TapHand -> Bool
$c>= :: TapHand -> TapHand -> Bool
> :: TapHand -> TapHand -> Bool
$c> :: TapHand -> TapHand -> Bool
<= :: TapHand -> TapHand -> Bool
$c<= :: TapHand -> TapHand -> Bool
< :: TapHand -> TapHand -> Bool
$c< :: TapHand -> TapHand -> Bool
compare :: TapHand -> TapHand -> Ordering
$ccompare :: TapHand -> TapHand -> Ordering
$cp1Ord :: Eq TapHand
Ord,Int -> TapHand
TapHand -> Int
TapHand -> [TapHand]
TapHand -> TapHand
TapHand -> TapHand -> [TapHand]
TapHand -> TapHand -> TapHand -> [TapHand]
(TapHand -> TapHand)
-> (TapHand -> TapHand)
-> (Int -> TapHand)
-> (TapHand -> Int)
-> (TapHand -> [TapHand])
-> (TapHand -> TapHand -> [TapHand])
-> (TapHand -> TapHand -> [TapHand])
-> (TapHand -> TapHand -> TapHand -> [TapHand])
-> Enum TapHand
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TapHand -> TapHand -> TapHand -> [TapHand]
$cenumFromThenTo :: TapHand -> TapHand -> TapHand -> [TapHand]
enumFromTo :: TapHand -> TapHand -> [TapHand]
$cenumFromTo :: TapHand -> TapHand -> [TapHand]
enumFromThen :: TapHand -> TapHand -> [TapHand]
$cenumFromThen :: TapHand -> TapHand -> [TapHand]
enumFrom :: TapHand -> [TapHand]
$cenumFrom :: TapHand -> [TapHand]
fromEnum :: TapHand -> Int
$cfromEnum :: TapHand -> Int
toEnum :: Int -> TapHand
$ctoEnum :: Int -> TapHand
pred :: TapHand -> TapHand
$cpred :: TapHand -> TapHand
succ :: TapHand -> TapHand
$csucc :: TapHand -> TapHand
Enum,TapHand
TapHand -> TapHand -> Bounded TapHand
forall a. a -> a -> Bounded a
maxBound :: TapHand
$cmaxBound :: TapHand
minBound :: TapHand
$cminBound :: TapHand
Bounded)
instance EmitXml TapHand where
    emitXml :: TapHand -> XmlRep
emitXml TapHand
TapHandLeft = String -> XmlRep
XLit String
"left"
    emitXml TapHand
TapHandRight = String -> XmlRep
XLit String
"right"
parseTapHand :: String -> P.XParse TapHand
parseTapHand :: String -> XParse TapHand
parseTapHand String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = TapHand -> XParse TapHand
forall (m :: * -> *) a. Monad m => a -> m a
return (TapHand -> XParse TapHand) -> TapHand -> XParse TapHand
forall a b. (a -> b) -> a -> b
$ TapHand
TapHandLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = TapHand -> XParse TapHand
forall (m :: * -> *) a. Monad m => a -> m a
return (TapHand -> XParse TapHand) -> TapHand -> XParse TapHand
forall a b. (a -> b) -> a -> b
$ TapHand
TapHandRight
        | Bool
otherwise = String -> XParse TapHand
forall a. String -> XParse a
P.xfail (String -> XParse TapHand) -> String -> XParse TapHand
forall a b. (a -> b) -> a -> b
$ String
"TapHand: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @tenths@ /(simple)/
--
-- The tenths type is a number representing tenths of interline staff space (positive or negative). Both integer and decimal values are allowed, such as 5 for a half space and 2.5 for a quarter space. Interline space is measured from the middle of a staff line.
-- 
-- Distances in a MusicXML file are measured in tenths of staff space. Tenths are then scaled to millimeters within the scaling element, used in the defaults element at the start of a score. Individual staves can apply a scaling factor to adjust staff size. When a MusicXML element or attribute refers to tenths, it means the global tenths defined by the scaling element, not the local tenths as adjusted by the staff-size element.
newtype Tenths = Tenths { Tenths -> Decimal
tenths :: Decimal }
    deriving (Tenths -> Tenths -> Bool
(Tenths -> Tenths -> Bool)
-> (Tenths -> Tenths -> Bool) -> Eq Tenths
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tenths -> Tenths -> Bool
$c/= :: Tenths -> Tenths -> Bool
== :: Tenths -> Tenths -> Bool
$c== :: Tenths -> Tenths -> Bool
Eq,Typeable,(forall x. Tenths -> Rep Tenths x)
-> (forall x. Rep Tenths x -> Tenths) -> Generic Tenths
forall x. Rep Tenths x -> Tenths
forall x. Tenths -> Rep Tenths x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tenths x -> Tenths
$cfrom :: forall x. Tenths -> Rep Tenths x
Generic,Eq Tenths
Eq Tenths
-> (Tenths -> Tenths -> Ordering)
-> (Tenths -> Tenths -> Bool)
-> (Tenths -> Tenths -> Bool)
-> (Tenths -> Tenths -> Bool)
-> (Tenths -> Tenths -> Bool)
-> (Tenths -> Tenths -> Tenths)
-> (Tenths -> Tenths -> Tenths)
-> Ord Tenths
Tenths -> Tenths -> Bool
Tenths -> Tenths -> Ordering
Tenths -> Tenths -> Tenths
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tenths -> Tenths -> Tenths
$cmin :: Tenths -> Tenths -> Tenths
max :: Tenths -> Tenths -> Tenths
$cmax :: Tenths -> Tenths -> Tenths
>= :: Tenths -> Tenths -> Bool
$c>= :: Tenths -> Tenths -> Bool
> :: Tenths -> Tenths -> Bool
$c> :: Tenths -> Tenths -> Bool
<= :: Tenths -> Tenths -> Bool
$c<= :: Tenths -> Tenths -> Bool
< :: Tenths -> Tenths -> Bool
$c< :: Tenths -> Tenths -> Bool
compare :: Tenths -> Tenths -> Ordering
$ccompare :: Tenths -> Tenths -> Ordering
$cp1Ord :: Eq Tenths
Ord,Integer -> Tenths
Tenths -> Tenths
Tenths -> Tenths -> Tenths
(Tenths -> Tenths -> Tenths)
-> (Tenths -> Tenths -> Tenths)
-> (Tenths -> Tenths -> Tenths)
-> (Tenths -> Tenths)
-> (Tenths -> Tenths)
-> (Tenths -> Tenths)
-> (Integer -> Tenths)
-> Num Tenths
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Tenths
$cfromInteger :: Integer -> Tenths
signum :: Tenths -> Tenths
$csignum :: Tenths -> Tenths
abs :: Tenths -> Tenths
$cabs :: Tenths -> Tenths
negate :: Tenths -> Tenths
$cnegate :: Tenths -> Tenths
* :: Tenths -> Tenths -> Tenths
$c* :: Tenths -> Tenths -> Tenths
- :: Tenths -> Tenths -> Tenths
$c- :: Tenths -> Tenths -> Tenths
+ :: Tenths -> Tenths -> Tenths
$c+ :: Tenths -> Tenths -> Tenths
Num,Num Tenths
Ord Tenths
Num Tenths -> Ord Tenths -> (Tenths -> Rational) -> Real Tenths
Tenths -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Tenths -> Rational
$ctoRational :: Tenths -> Rational
$cp2Real :: Ord Tenths
$cp1Real :: Num Tenths
Real,Num Tenths
Num Tenths
-> (Tenths -> Tenths -> Tenths)
-> (Tenths -> Tenths)
-> (Rational -> Tenths)
-> Fractional Tenths
Rational -> Tenths
Tenths -> Tenths
Tenths -> Tenths -> Tenths
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Tenths
$cfromRational :: Rational -> Tenths
recip :: Tenths -> Tenths
$crecip :: Tenths -> Tenths
/ :: Tenths -> Tenths -> Tenths
$c/ :: Tenths -> Tenths -> Tenths
$cp1Fractional :: Num Tenths
Fractional,Fractional Tenths
Real Tenths
Real Tenths
-> Fractional Tenths
-> (forall b. Integral b => Tenths -> (b, Tenths))
-> (forall b. Integral b => Tenths -> b)
-> (forall b. Integral b => Tenths -> b)
-> (forall b. Integral b => Tenths -> b)
-> (forall b. Integral b => Tenths -> b)
-> RealFrac Tenths
Tenths -> b
Tenths -> b
Tenths -> b
Tenths -> b
Tenths -> (b, Tenths)
forall b. Integral b => Tenths -> b
forall b. Integral b => Tenths -> (b, Tenths)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: Tenths -> b
$cfloor :: forall b. Integral b => Tenths -> b
ceiling :: Tenths -> b
$cceiling :: forall b. Integral b => Tenths -> b
round :: Tenths -> b
$cround :: forall b. Integral b => Tenths -> b
truncate :: Tenths -> b
$ctruncate :: forall b. Integral b => Tenths -> b
properFraction :: Tenths -> (b, Tenths)
$cproperFraction :: forall b. Integral b => Tenths -> (b, Tenths)
$cp2RealFrac :: Fractional Tenths
$cp1RealFrac :: Real Tenths
RealFrac)
instance Show Tenths where show :: Tenths -> String
show (Tenths Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read Tenths where readsPrec :: Int -> ReadS Tenths
readsPrec Int
i = ((Decimal, String) -> (Tenths, String))
-> [(Decimal, String)] -> [(Tenths, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> Tenths) -> (Decimal, String) -> (Tenths, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> Tenths
Tenths) ([(Decimal, String)] -> [(Tenths, String)])
-> (String -> [(Decimal, String)]) -> ReadS Tenths
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Tenths where
    emitXml :: Tenths -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep) -> (Tenths -> Decimal) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tenths -> Decimal
tenths
parseTenths :: String -> P.XParse Tenths
parseTenths :: String -> XParse Tenths
parseTenths = String -> String -> XParse Tenths
forall a. Read a => String -> String -> XParse a
P.xread String
"Tenths"

-- | @text-direction@ /(simple)/
--
-- The text-direction type is used to adjust and override the Unicode bidirectional text algorithm, similar to the W3C Internationalization Tag Set recommendation. Values are ltr (left-to-right embed), rtl (right-to-left embed), lro (left-to-right bidi-override), and rlo (right-to-left bidi-override). The default value is ltr. This type is typically used by applications that store text in left-to-right visual order rather than logical order. Such applications can use the lro value to better communicate with other applications that more fully support bidirectional text.
data TextDirection = 
      TextDirectionLtr -- ^ /ltr/
    | TextDirectionRtl -- ^ /rtl/
    | TextDirectionLro -- ^ /lro/
    | TextDirectionRlo -- ^ /rlo/
    deriving (TextDirection -> TextDirection -> Bool
(TextDirection -> TextDirection -> Bool)
-> (TextDirection -> TextDirection -> Bool) -> Eq TextDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDirection -> TextDirection -> Bool
$c/= :: TextDirection -> TextDirection -> Bool
== :: TextDirection -> TextDirection -> Bool
$c== :: TextDirection -> TextDirection -> Bool
Eq,Typeable,(forall x. TextDirection -> Rep TextDirection x)
-> (forall x. Rep TextDirection x -> TextDirection)
-> Generic TextDirection
forall x. Rep TextDirection x -> TextDirection
forall x. TextDirection -> Rep TextDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextDirection x -> TextDirection
$cfrom :: forall x. TextDirection -> Rep TextDirection x
Generic,Int -> TextDirection -> ShowS
[TextDirection] -> ShowS
TextDirection -> String
(Int -> TextDirection -> ShowS)
-> (TextDirection -> String)
-> ([TextDirection] -> ShowS)
-> Show TextDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDirection] -> ShowS
$cshowList :: [TextDirection] -> ShowS
show :: TextDirection -> String
$cshow :: TextDirection -> String
showsPrec :: Int -> TextDirection -> ShowS
$cshowsPrec :: Int -> TextDirection -> ShowS
Show,Eq TextDirection
Eq TextDirection
-> (TextDirection -> TextDirection -> Ordering)
-> (TextDirection -> TextDirection -> Bool)
-> (TextDirection -> TextDirection -> Bool)
-> (TextDirection -> TextDirection -> Bool)
-> (TextDirection -> TextDirection -> Bool)
-> (TextDirection -> TextDirection -> TextDirection)
-> (TextDirection -> TextDirection -> TextDirection)
-> Ord TextDirection
TextDirection -> TextDirection -> Bool
TextDirection -> TextDirection -> Ordering
TextDirection -> TextDirection -> TextDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TextDirection -> TextDirection -> TextDirection
$cmin :: TextDirection -> TextDirection -> TextDirection
max :: TextDirection -> TextDirection -> TextDirection
$cmax :: TextDirection -> TextDirection -> TextDirection
>= :: TextDirection -> TextDirection -> Bool
$c>= :: TextDirection -> TextDirection -> Bool
> :: TextDirection -> TextDirection -> Bool
$c> :: TextDirection -> TextDirection -> Bool
<= :: TextDirection -> TextDirection -> Bool
$c<= :: TextDirection -> TextDirection -> Bool
< :: TextDirection -> TextDirection -> Bool
$c< :: TextDirection -> TextDirection -> Bool
compare :: TextDirection -> TextDirection -> Ordering
$ccompare :: TextDirection -> TextDirection -> Ordering
$cp1Ord :: Eq TextDirection
Ord,Int -> TextDirection
TextDirection -> Int
TextDirection -> [TextDirection]
TextDirection -> TextDirection
TextDirection -> TextDirection -> [TextDirection]
TextDirection -> TextDirection -> TextDirection -> [TextDirection]
(TextDirection -> TextDirection)
-> (TextDirection -> TextDirection)
-> (Int -> TextDirection)
-> (TextDirection -> Int)
-> (TextDirection -> [TextDirection])
-> (TextDirection -> TextDirection -> [TextDirection])
-> (TextDirection -> TextDirection -> [TextDirection])
-> (TextDirection
    -> TextDirection -> TextDirection -> [TextDirection])
-> Enum TextDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TextDirection -> TextDirection -> TextDirection -> [TextDirection]
$cenumFromThenTo :: TextDirection -> TextDirection -> TextDirection -> [TextDirection]
enumFromTo :: TextDirection -> TextDirection -> [TextDirection]
$cenumFromTo :: TextDirection -> TextDirection -> [TextDirection]
enumFromThen :: TextDirection -> TextDirection -> [TextDirection]
$cenumFromThen :: TextDirection -> TextDirection -> [TextDirection]
enumFrom :: TextDirection -> [TextDirection]
$cenumFrom :: TextDirection -> [TextDirection]
fromEnum :: TextDirection -> Int
$cfromEnum :: TextDirection -> Int
toEnum :: Int -> TextDirection
$ctoEnum :: Int -> TextDirection
pred :: TextDirection -> TextDirection
$cpred :: TextDirection -> TextDirection
succ :: TextDirection -> TextDirection
$csucc :: TextDirection -> TextDirection
Enum,TextDirection
TextDirection -> TextDirection -> Bounded TextDirection
forall a. a -> a -> Bounded a
maxBound :: TextDirection
$cmaxBound :: TextDirection
minBound :: TextDirection
$cminBound :: TextDirection
Bounded)
instance EmitXml TextDirection where
    emitXml :: TextDirection -> XmlRep
emitXml TextDirection
TextDirectionLtr = String -> XmlRep
XLit String
"ltr"
    emitXml TextDirection
TextDirectionRtl = String -> XmlRep
XLit String
"rtl"
    emitXml TextDirection
TextDirectionLro = String -> XmlRep
XLit String
"lro"
    emitXml TextDirection
TextDirectionRlo = String -> XmlRep
XLit String
"rlo"
parseTextDirection :: String -> P.XParse TextDirection
parseTextDirection :: String -> XParse TextDirection
parseTextDirection String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ltr" = TextDirection -> XParse TextDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TextDirection -> XParse TextDirection)
-> TextDirection -> XParse TextDirection
forall a b. (a -> b) -> a -> b
$ TextDirection
TextDirectionLtr
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rtl" = TextDirection -> XParse TextDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TextDirection -> XParse TextDirection)
-> TextDirection -> XParse TextDirection
forall a b. (a -> b) -> a -> b
$ TextDirection
TextDirectionRtl
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"lro" = TextDirection -> XParse TextDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TextDirection -> XParse TextDirection)
-> TextDirection -> XParse TextDirection
forall a b. (a -> b) -> a -> b
$ TextDirection
TextDirectionLro
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rlo" = TextDirection -> XParse TextDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TextDirection -> XParse TextDirection)
-> TextDirection -> XParse TextDirection
forall a b. (a -> b) -> a -> b
$ TextDirection
TextDirectionRlo
        | Bool
otherwise = String -> XParse TextDirection
forall a. String -> XParse a
P.xfail (String -> XParse TextDirection) -> String -> XParse TextDirection
forall a b. (a -> b) -> a -> b
$ String
"TextDirection: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @tied-type@ /(simple)/
--
-- The tied-type type is used as an attribute of the tied element to specify where the visual representation of a tie begins and ends. A tied element which joins two notes of the same pitch can be specified with tied-type start on the first note and tied-type stop on the second note. To indicate a note should be undamped, use a single tied element with tied-type let-ring. For other ties that are visually attached to a single note, such as a tie leading into or out of a repeated section or coda, use two tied elements on the same note, one start and one stop.
-- 
-- In start-stop cases, ties can add more elements using a continue type. This is typically used to specify the formatting of cross-system ties.
data TiedType = 
      TiedTypeStart -- ^ /start/
    | TiedTypeStop -- ^ /stop/
    | TiedTypeContinue -- ^ /continue/
    | TiedTypeLetRing -- ^ /let-ring/
    deriving (TiedType -> TiedType -> Bool
(TiedType -> TiedType -> Bool)
-> (TiedType -> TiedType -> Bool) -> Eq TiedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TiedType -> TiedType -> Bool
$c/= :: TiedType -> TiedType -> Bool
== :: TiedType -> TiedType -> Bool
$c== :: TiedType -> TiedType -> Bool
Eq,Typeable,(forall x. TiedType -> Rep TiedType x)
-> (forall x. Rep TiedType x -> TiedType) -> Generic TiedType
forall x. Rep TiedType x -> TiedType
forall x. TiedType -> Rep TiedType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TiedType x -> TiedType
$cfrom :: forall x. TiedType -> Rep TiedType x
Generic,Int -> TiedType -> ShowS
[TiedType] -> ShowS
TiedType -> String
(Int -> TiedType -> ShowS)
-> (TiedType -> String) -> ([TiedType] -> ShowS) -> Show TiedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TiedType] -> ShowS
$cshowList :: [TiedType] -> ShowS
show :: TiedType -> String
$cshow :: TiedType -> String
showsPrec :: Int -> TiedType -> ShowS
$cshowsPrec :: Int -> TiedType -> ShowS
Show,Eq TiedType
Eq TiedType
-> (TiedType -> TiedType -> Ordering)
-> (TiedType -> TiedType -> Bool)
-> (TiedType -> TiedType -> Bool)
-> (TiedType -> TiedType -> Bool)
-> (TiedType -> TiedType -> Bool)
-> (TiedType -> TiedType -> TiedType)
-> (TiedType -> TiedType -> TiedType)
-> Ord TiedType
TiedType -> TiedType -> Bool
TiedType -> TiedType -> Ordering
TiedType -> TiedType -> TiedType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TiedType -> TiedType -> TiedType
$cmin :: TiedType -> TiedType -> TiedType
max :: TiedType -> TiedType -> TiedType
$cmax :: TiedType -> TiedType -> TiedType
>= :: TiedType -> TiedType -> Bool
$c>= :: TiedType -> TiedType -> Bool
> :: TiedType -> TiedType -> Bool
$c> :: TiedType -> TiedType -> Bool
<= :: TiedType -> TiedType -> Bool
$c<= :: TiedType -> TiedType -> Bool
< :: TiedType -> TiedType -> Bool
$c< :: TiedType -> TiedType -> Bool
compare :: TiedType -> TiedType -> Ordering
$ccompare :: TiedType -> TiedType -> Ordering
$cp1Ord :: Eq TiedType
Ord,Int -> TiedType
TiedType -> Int
TiedType -> [TiedType]
TiedType -> TiedType
TiedType -> TiedType -> [TiedType]
TiedType -> TiedType -> TiedType -> [TiedType]
(TiedType -> TiedType)
-> (TiedType -> TiedType)
-> (Int -> TiedType)
-> (TiedType -> Int)
-> (TiedType -> [TiedType])
-> (TiedType -> TiedType -> [TiedType])
-> (TiedType -> TiedType -> [TiedType])
-> (TiedType -> TiedType -> TiedType -> [TiedType])
-> Enum TiedType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TiedType -> TiedType -> TiedType -> [TiedType]
$cenumFromThenTo :: TiedType -> TiedType -> TiedType -> [TiedType]
enumFromTo :: TiedType -> TiedType -> [TiedType]
$cenumFromTo :: TiedType -> TiedType -> [TiedType]
enumFromThen :: TiedType -> TiedType -> [TiedType]
$cenumFromThen :: TiedType -> TiedType -> [TiedType]
enumFrom :: TiedType -> [TiedType]
$cenumFrom :: TiedType -> [TiedType]
fromEnum :: TiedType -> Int
$cfromEnum :: TiedType -> Int
toEnum :: Int -> TiedType
$ctoEnum :: Int -> TiedType
pred :: TiedType -> TiedType
$cpred :: TiedType -> TiedType
succ :: TiedType -> TiedType
$csucc :: TiedType -> TiedType
Enum,TiedType
TiedType -> TiedType -> Bounded TiedType
forall a. a -> a -> Bounded a
maxBound :: TiedType
$cmaxBound :: TiedType
minBound :: TiedType
$cminBound :: TiedType
Bounded)
instance EmitXml TiedType where
    emitXml :: TiedType -> XmlRep
emitXml TiedType
TiedTypeStart = String -> XmlRep
XLit String
"start"
    emitXml TiedType
TiedTypeStop = String -> XmlRep
XLit String
"stop"
    emitXml TiedType
TiedTypeContinue = String -> XmlRep
XLit String
"continue"
    emitXml TiedType
TiedTypeLetRing = String -> XmlRep
XLit String
"let-ring"
parseTiedType :: String -> P.XParse TiedType
parseTiedType :: String -> XParse TiedType
parseTiedType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = TiedType -> XParse TiedType
forall (m :: * -> *) a. Monad m => a -> m a
return (TiedType -> XParse TiedType) -> TiedType -> XParse TiedType
forall a b. (a -> b) -> a -> b
$ TiedType
TiedTypeStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = TiedType -> XParse TiedType
forall (m :: * -> *) a. Monad m => a -> m a
return (TiedType -> XParse TiedType) -> TiedType -> XParse TiedType
forall a b. (a -> b) -> a -> b
$ TiedType
TiedTypeStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = TiedType -> XParse TiedType
forall (m :: * -> *) a. Monad m => a -> m a
return (TiedType -> XParse TiedType) -> TiedType -> XParse TiedType
forall a b. (a -> b) -> a -> b
$ TiedType
TiedTypeContinue
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"let-ring" = TiedType -> XParse TiedType
forall (m :: * -> *) a. Monad m => a -> m a
return (TiedType -> XParse TiedType) -> TiedType -> XParse TiedType
forall a b. (a -> b) -> a -> b
$ TiedType
TiedTypeLetRing
        | Bool
otherwise = String -> XParse TiedType
forall a. String -> XParse a
P.xfail (String -> XParse TiedType) -> String -> XParse TiedType
forall a b. (a -> b) -> a -> b
$ String
"TiedType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @time-only@ /(simple)/
--
-- The time-only type is used to indicate that a particular playback-related element only applies particular times through a repeated section. The value is a comma-separated list of positive integers arranged in ascending order, indicating which times through the repeated section that the element applies.
newtype TimeOnly = TimeOnly { TimeOnly -> Token
timeOnly :: Token }
    deriving (TimeOnly -> TimeOnly -> Bool
(TimeOnly -> TimeOnly -> Bool)
-> (TimeOnly -> TimeOnly -> Bool) -> Eq TimeOnly
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOnly -> TimeOnly -> Bool
$c/= :: TimeOnly -> TimeOnly -> Bool
== :: TimeOnly -> TimeOnly -> Bool
$c== :: TimeOnly -> TimeOnly -> Bool
Eq,Typeable,(forall x. TimeOnly -> Rep TimeOnly x)
-> (forall x. Rep TimeOnly x -> TimeOnly) -> Generic TimeOnly
forall x. Rep TimeOnly x -> TimeOnly
forall x. TimeOnly -> Rep TimeOnly x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeOnly x -> TimeOnly
$cfrom :: forall x. TimeOnly -> Rep TimeOnly x
Generic,Eq TimeOnly
Eq TimeOnly
-> (TimeOnly -> TimeOnly -> Ordering)
-> (TimeOnly -> TimeOnly -> Bool)
-> (TimeOnly -> TimeOnly -> Bool)
-> (TimeOnly -> TimeOnly -> Bool)
-> (TimeOnly -> TimeOnly -> Bool)
-> (TimeOnly -> TimeOnly -> TimeOnly)
-> (TimeOnly -> TimeOnly -> TimeOnly)
-> Ord TimeOnly
TimeOnly -> TimeOnly -> Bool
TimeOnly -> TimeOnly -> Ordering
TimeOnly -> TimeOnly -> TimeOnly
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeOnly -> TimeOnly -> TimeOnly
$cmin :: TimeOnly -> TimeOnly -> TimeOnly
max :: TimeOnly -> TimeOnly -> TimeOnly
$cmax :: TimeOnly -> TimeOnly -> TimeOnly
>= :: TimeOnly -> TimeOnly -> Bool
$c>= :: TimeOnly -> TimeOnly -> Bool
> :: TimeOnly -> TimeOnly -> Bool
$c> :: TimeOnly -> TimeOnly -> Bool
<= :: TimeOnly -> TimeOnly -> Bool
$c<= :: TimeOnly -> TimeOnly -> Bool
< :: TimeOnly -> TimeOnly -> Bool
$c< :: TimeOnly -> TimeOnly -> Bool
compare :: TimeOnly -> TimeOnly -> Ordering
$ccompare :: TimeOnly -> TimeOnly -> Ordering
$cp1Ord :: Eq TimeOnly
Ord,String -> TimeOnly
(String -> TimeOnly) -> IsString TimeOnly
forall a. (String -> a) -> IsString a
fromString :: String -> TimeOnly
$cfromString :: String -> TimeOnly
IsString)
instance Show TimeOnly where show :: TimeOnly -> String
show (TimeOnly Token
a) = Token -> String
forall a. Show a => a -> String
show Token
a
instance Read TimeOnly where readsPrec :: Int -> ReadS TimeOnly
readsPrec Int
i = ((Token, String) -> (TimeOnly, String))
-> [(Token, String)] -> [(TimeOnly, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Token -> TimeOnly) -> (Token, String) -> (TimeOnly, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Token -> TimeOnly
TimeOnly) ([(Token, String)] -> [(TimeOnly, String)])
-> (String -> [(Token, String)]) -> ReadS TimeOnly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Token, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml TimeOnly where
    emitXml :: TimeOnly -> XmlRep
emitXml = Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Token -> XmlRep) -> (TimeOnly -> Token) -> TimeOnly -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOnly -> Token
timeOnly
parseTimeOnly :: String -> P.XParse TimeOnly
parseTimeOnly :: String -> XParse TimeOnly
parseTimeOnly = TimeOnly -> XParse TimeOnly
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOnly -> XParse TimeOnly)
-> (String -> TimeOnly) -> String -> XParse TimeOnly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TimeOnly
forall a. IsString a => String -> a
fromString

-- | @time-relation@ /(simple)/
--
-- The time-relation type indicates the symbol used to represent the interchangeable aspect of dual time signatures.
data TimeRelation = 
      TimeRelationParentheses -- ^ /parentheses/
    | TimeRelationBracket -- ^ /bracket/
    | TimeRelationEquals -- ^ /equals/
    | TimeRelationSlash -- ^ /slash/
    | TimeRelationSpace -- ^ /space/
    | TimeRelationHyphen -- ^ /hyphen/
    deriving (TimeRelation -> TimeRelation -> Bool
(TimeRelation -> TimeRelation -> Bool)
-> (TimeRelation -> TimeRelation -> Bool) -> Eq TimeRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeRelation -> TimeRelation -> Bool
$c/= :: TimeRelation -> TimeRelation -> Bool
== :: TimeRelation -> TimeRelation -> Bool
$c== :: TimeRelation -> TimeRelation -> Bool
Eq,Typeable,(forall x. TimeRelation -> Rep TimeRelation x)
-> (forall x. Rep TimeRelation x -> TimeRelation)
-> Generic TimeRelation
forall x. Rep TimeRelation x -> TimeRelation
forall x. TimeRelation -> Rep TimeRelation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeRelation x -> TimeRelation
$cfrom :: forall x. TimeRelation -> Rep TimeRelation x
Generic,Int -> TimeRelation -> ShowS
[TimeRelation] -> ShowS
TimeRelation -> String
(Int -> TimeRelation -> ShowS)
-> (TimeRelation -> String)
-> ([TimeRelation] -> ShowS)
-> Show TimeRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeRelation] -> ShowS
$cshowList :: [TimeRelation] -> ShowS
show :: TimeRelation -> String
$cshow :: TimeRelation -> String
showsPrec :: Int -> TimeRelation -> ShowS
$cshowsPrec :: Int -> TimeRelation -> ShowS
Show,Eq TimeRelation
Eq TimeRelation
-> (TimeRelation -> TimeRelation -> Ordering)
-> (TimeRelation -> TimeRelation -> Bool)
-> (TimeRelation -> TimeRelation -> Bool)
-> (TimeRelation -> TimeRelation -> Bool)
-> (TimeRelation -> TimeRelation -> Bool)
-> (TimeRelation -> TimeRelation -> TimeRelation)
-> (TimeRelation -> TimeRelation -> TimeRelation)
-> Ord TimeRelation
TimeRelation -> TimeRelation -> Bool
TimeRelation -> TimeRelation -> Ordering
TimeRelation -> TimeRelation -> TimeRelation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeRelation -> TimeRelation -> TimeRelation
$cmin :: TimeRelation -> TimeRelation -> TimeRelation
max :: TimeRelation -> TimeRelation -> TimeRelation
$cmax :: TimeRelation -> TimeRelation -> TimeRelation
>= :: TimeRelation -> TimeRelation -> Bool
$c>= :: TimeRelation -> TimeRelation -> Bool
> :: TimeRelation -> TimeRelation -> Bool
$c> :: TimeRelation -> TimeRelation -> Bool
<= :: TimeRelation -> TimeRelation -> Bool
$c<= :: TimeRelation -> TimeRelation -> Bool
< :: TimeRelation -> TimeRelation -> Bool
$c< :: TimeRelation -> TimeRelation -> Bool
compare :: TimeRelation -> TimeRelation -> Ordering
$ccompare :: TimeRelation -> TimeRelation -> Ordering
$cp1Ord :: Eq TimeRelation
Ord,Int -> TimeRelation
TimeRelation -> Int
TimeRelation -> [TimeRelation]
TimeRelation -> TimeRelation
TimeRelation -> TimeRelation -> [TimeRelation]
TimeRelation -> TimeRelation -> TimeRelation -> [TimeRelation]
(TimeRelation -> TimeRelation)
-> (TimeRelation -> TimeRelation)
-> (Int -> TimeRelation)
-> (TimeRelation -> Int)
-> (TimeRelation -> [TimeRelation])
-> (TimeRelation -> TimeRelation -> [TimeRelation])
-> (TimeRelation -> TimeRelation -> [TimeRelation])
-> (TimeRelation -> TimeRelation -> TimeRelation -> [TimeRelation])
-> Enum TimeRelation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeRelation -> TimeRelation -> TimeRelation -> [TimeRelation]
$cenumFromThenTo :: TimeRelation -> TimeRelation -> TimeRelation -> [TimeRelation]
enumFromTo :: TimeRelation -> TimeRelation -> [TimeRelation]
$cenumFromTo :: TimeRelation -> TimeRelation -> [TimeRelation]
enumFromThen :: TimeRelation -> TimeRelation -> [TimeRelation]
$cenumFromThen :: TimeRelation -> TimeRelation -> [TimeRelation]
enumFrom :: TimeRelation -> [TimeRelation]
$cenumFrom :: TimeRelation -> [TimeRelation]
fromEnum :: TimeRelation -> Int
$cfromEnum :: TimeRelation -> Int
toEnum :: Int -> TimeRelation
$ctoEnum :: Int -> TimeRelation
pred :: TimeRelation -> TimeRelation
$cpred :: TimeRelation -> TimeRelation
succ :: TimeRelation -> TimeRelation
$csucc :: TimeRelation -> TimeRelation
Enum,TimeRelation
TimeRelation -> TimeRelation -> Bounded TimeRelation
forall a. a -> a -> Bounded a
maxBound :: TimeRelation
$cmaxBound :: TimeRelation
minBound :: TimeRelation
$cminBound :: TimeRelation
Bounded)
instance EmitXml TimeRelation where
    emitXml :: TimeRelation -> XmlRep
emitXml TimeRelation
TimeRelationParentheses = String -> XmlRep
XLit String
"parentheses"
    emitXml TimeRelation
TimeRelationBracket = String -> XmlRep
XLit String
"bracket"
    emitXml TimeRelation
TimeRelationEquals = String -> XmlRep
XLit String
"equals"
    emitXml TimeRelation
TimeRelationSlash = String -> XmlRep
XLit String
"slash"
    emitXml TimeRelation
TimeRelationSpace = String -> XmlRep
XLit String
"space"
    emitXml TimeRelation
TimeRelationHyphen = String -> XmlRep
XLit String
"hyphen"
parseTimeRelation :: String -> P.XParse TimeRelation
parseTimeRelation :: String -> XParse TimeRelation
parseTimeRelation String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"parentheses" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationParentheses
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bracket" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationBracket
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"equals" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationEquals
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slash" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationSlash
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"space" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationSpace
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hyphen" = TimeRelation -> XParse TimeRelation
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeRelation -> XParse TimeRelation)
-> TimeRelation -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ TimeRelation
TimeRelationHyphen
        | Bool
otherwise = String -> XParse TimeRelation
forall a. String -> XParse a
P.xfail (String -> XParse TimeRelation) -> String -> XParse TimeRelation
forall a b. (a -> b) -> a -> b
$ String
"TimeRelation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @time-separator@ /(simple)/
--
-- The time-separator type indicates how to display the arrangement between the beats and beat-type values in a time signature. The default value is none. The horizontal, diagonal, and vertical values represent horizontal, diagonal lower-left to upper-right, and vertical lines respectively. For these values, the beats and beat-type values are arranged on either side of the separator line. The none value represents no separator with the beats and beat-type arranged vertically. The adjacent value represents no separator with the beats and beat-type arranged horizontally.
data TimeSeparator = 
      TimeSeparatorNone -- ^ /none/
    | TimeSeparatorHorizontal -- ^ /horizontal/
    | TimeSeparatorDiagonal -- ^ /diagonal/
    | TimeSeparatorVertical -- ^ /vertical/
    | TimeSeparatorAdjacent -- ^ /adjacent/
    deriving (TimeSeparator -> TimeSeparator -> Bool
(TimeSeparator -> TimeSeparator -> Bool)
-> (TimeSeparator -> TimeSeparator -> Bool) -> Eq TimeSeparator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeSeparator -> TimeSeparator -> Bool
$c/= :: TimeSeparator -> TimeSeparator -> Bool
== :: TimeSeparator -> TimeSeparator -> Bool
$c== :: TimeSeparator -> TimeSeparator -> Bool
Eq,Typeable,(forall x. TimeSeparator -> Rep TimeSeparator x)
-> (forall x. Rep TimeSeparator x -> TimeSeparator)
-> Generic TimeSeparator
forall x. Rep TimeSeparator x -> TimeSeparator
forall x. TimeSeparator -> Rep TimeSeparator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeSeparator x -> TimeSeparator
$cfrom :: forall x. TimeSeparator -> Rep TimeSeparator x
Generic,Int -> TimeSeparator -> ShowS
[TimeSeparator] -> ShowS
TimeSeparator -> String
(Int -> TimeSeparator -> ShowS)
-> (TimeSeparator -> String)
-> ([TimeSeparator] -> ShowS)
-> Show TimeSeparator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeSeparator] -> ShowS
$cshowList :: [TimeSeparator] -> ShowS
show :: TimeSeparator -> String
$cshow :: TimeSeparator -> String
showsPrec :: Int -> TimeSeparator -> ShowS
$cshowsPrec :: Int -> TimeSeparator -> ShowS
Show,Eq TimeSeparator
Eq TimeSeparator
-> (TimeSeparator -> TimeSeparator -> Ordering)
-> (TimeSeparator -> TimeSeparator -> Bool)
-> (TimeSeparator -> TimeSeparator -> Bool)
-> (TimeSeparator -> TimeSeparator -> Bool)
-> (TimeSeparator -> TimeSeparator -> Bool)
-> (TimeSeparator -> TimeSeparator -> TimeSeparator)
-> (TimeSeparator -> TimeSeparator -> TimeSeparator)
-> Ord TimeSeparator
TimeSeparator -> TimeSeparator -> Bool
TimeSeparator -> TimeSeparator -> Ordering
TimeSeparator -> TimeSeparator -> TimeSeparator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeSeparator -> TimeSeparator -> TimeSeparator
$cmin :: TimeSeparator -> TimeSeparator -> TimeSeparator
max :: TimeSeparator -> TimeSeparator -> TimeSeparator
$cmax :: TimeSeparator -> TimeSeparator -> TimeSeparator
>= :: TimeSeparator -> TimeSeparator -> Bool
$c>= :: TimeSeparator -> TimeSeparator -> Bool
> :: TimeSeparator -> TimeSeparator -> Bool
$c> :: TimeSeparator -> TimeSeparator -> Bool
<= :: TimeSeparator -> TimeSeparator -> Bool
$c<= :: TimeSeparator -> TimeSeparator -> Bool
< :: TimeSeparator -> TimeSeparator -> Bool
$c< :: TimeSeparator -> TimeSeparator -> Bool
compare :: TimeSeparator -> TimeSeparator -> Ordering
$ccompare :: TimeSeparator -> TimeSeparator -> Ordering
$cp1Ord :: Eq TimeSeparator
Ord,Int -> TimeSeparator
TimeSeparator -> Int
TimeSeparator -> [TimeSeparator]
TimeSeparator -> TimeSeparator
TimeSeparator -> TimeSeparator -> [TimeSeparator]
TimeSeparator -> TimeSeparator -> TimeSeparator -> [TimeSeparator]
(TimeSeparator -> TimeSeparator)
-> (TimeSeparator -> TimeSeparator)
-> (Int -> TimeSeparator)
-> (TimeSeparator -> Int)
-> (TimeSeparator -> [TimeSeparator])
-> (TimeSeparator -> TimeSeparator -> [TimeSeparator])
-> (TimeSeparator -> TimeSeparator -> [TimeSeparator])
-> (TimeSeparator
    -> TimeSeparator -> TimeSeparator -> [TimeSeparator])
-> Enum TimeSeparator
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeSeparator -> TimeSeparator -> TimeSeparator -> [TimeSeparator]
$cenumFromThenTo :: TimeSeparator -> TimeSeparator -> TimeSeparator -> [TimeSeparator]
enumFromTo :: TimeSeparator -> TimeSeparator -> [TimeSeparator]
$cenumFromTo :: TimeSeparator -> TimeSeparator -> [TimeSeparator]
enumFromThen :: TimeSeparator -> TimeSeparator -> [TimeSeparator]
$cenumFromThen :: TimeSeparator -> TimeSeparator -> [TimeSeparator]
enumFrom :: TimeSeparator -> [TimeSeparator]
$cenumFrom :: TimeSeparator -> [TimeSeparator]
fromEnum :: TimeSeparator -> Int
$cfromEnum :: TimeSeparator -> Int
toEnum :: Int -> TimeSeparator
$ctoEnum :: Int -> TimeSeparator
pred :: TimeSeparator -> TimeSeparator
$cpred :: TimeSeparator -> TimeSeparator
succ :: TimeSeparator -> TimeSeparator
$csucc :: TimeSeparator -> TimeSeparator
Enum,TimeSeparator
TimeSeparator -> TimeSeparator -> Bounded TimeSeparator
forall a. a -> a -> Bounded a
maxBound :: TimeSeparator
$cmaxBound :: TimeSeparator
minBound :: TimeSeparator
$cminBound :: TimeSeparator
Bounded)
instance EmitXml TimeSeparator where
    emitXml :: TimeSeparator -> XmlRep
emitXml TimeSeparator
TimeSeparatorNone = String -> XmlRep
XLit String
"none"
    emitXml TimeSeparator
TimeSeparatorHorizontal = String -> XmlRep
XLit String
"horizontal"
    emitXml TimeSeparator
TimeSeparatorDiagonal = String -> XmlRep
XLit String
"diagonal"
    emitXml TimeSeparator
TimeSeparatorVertical = String -> XmlRep
XLit String
"vertical"
    emitXml TimeSeparator
TimeSeparatorAdjacent = String -> XmlRep
XLit String
"adjacent"
parseTimeSeparator :: String -> P.XParse TimeSeparator
parseTimeSeparator :: String -> XParse TimeSeparator
parseTimeSeparator String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = TimeSeparator -> XParse TimeSeparator
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSeparator -> XParse TimeSeparator)
-> TimeSeparator -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ TimeSeparator
TimeSeparatorNone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"horizontal" = TimeSeparator -> XParse TimeSeparator
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSeparator -> XParse TimeSeparator)
-> TimeSeparator -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ TimeSeparator
TimeSeparatorHorizontal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diagonal" = TimeSeparator -> XParse TimeSeparator
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSeparator -> XParse TimeSeparator)
-> TimeSeparator -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ TimeSeparator
TimeSeparatorDiagonal
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"vertical" = TimeSeparator -> XParse TimeSeparator
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSeparator -> XParse TimeSeparator)
-> TimeSeparator -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ TimeSeparator
TimeSeparatorVertical
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"adjacent" = TimeSeparator -> XParse TimeSeparator
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSeparator -> XParse TimeSeparator)
-> TimeSeparator -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ TimeSeparator
TimeSeparatorAdjacent
        | Bool
otherwise = String -> XParse TimeSeparator
forall a. String -> XParse a
P.xfail (String -> XParse TimeSeparator) -> String -> XParse TimeSeparator
forall a b. (a -> b) -> a -> b
$ String
"TimeSeparator: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @time-symbol@ /(simple)/
--
-- The time-symbol type indicates how to display a time signature. The normal value is the usual fractional display, and is the implied symbol type if none is specified. Other options are the common and cut time symbols, as well as a single number with an implied denominator. The note symbol indicates that the beat-type should be represented with the corresponding downstem note rather than a number. The dotted-note symbol indicates that the beat-type should be represented with a dotted downstem note that corresponds to three times the beat-type value, and a numerator that is one third the beats value.
data TimeSymbol = 
      TimeSymbolCommon -- ^ /common/
    | TimeSymbolCut -- ^ /cut/
    | TimeSymbolSingleNumber -- ^ /single-number/
    | TimeSymbolNote -- ^ /note/
    | TimeSymbolDottedNote -- ^ /dotted-note/
    | TimeSymbolNormal -- ^ /normal/
    deriving (TimeSymbol -> TimeSymbol -> Bool
(TimeSymbol -> TimeSymbol -> Bool)
-> (TimeSymbol -> TimeSymbol -> Bool) -> Eq TimeSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeSymbol -> TimeSymbol -> Bool
$c/= :: TimeSymbol -> TimeSymbol -> Bool
== :: TimeSymbol -> TimeSymbol -> Bool
$c== :: TimeSymbol -> TimeSymbol -> Bool
Eq,Typeable,(forall x. TimeSymbol -> Rep TimeSymbol x)
-> (forall x. Rep TimeSymbol x -> TimeSymbol) -> Generic TimeSymbol
forall x. Rep TimeSymbol x -> TimeSymbol
forall x. TimeSymbol -> Rep TimeSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeSymbol x -> TimeSymbol
$cfrom :: forall x. TimeSymbol -> Rep TimeSymbol x
Generic,Int -> TimeSymbol -> ShowS
[TimeSymbol] -> ShowS
TimeSymbol -> String
(Int -> TimeSymbol -> ShowS)
-> (TimeSymbol -> String)
-> ([TimeSymbol] -> ShowS)
-> Show TimeSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeSymbol] -> ShowS
$cshowList :: [TimeSymbol] -> ShowS
show :: TimeSymbol -> String
$cshow :: TimeSymbol -> String
showsPrec :: Int -> TimeSymbol -> ShowS
$cshowsPrec :: Int -> TimeSymbol -> ShowS
Show,Eq TimeSymbol
Eq TimeSymbol
-> (TimeSymbol -> TimeSymbol -> Ordering)
-> (TimeSymbol -> TimeSymbol -> Bool)
-> (TimeSymbol -> TimeSymbol -> Bool)
-> (TimeSymbol -> TimeSymbol -> Bool)
-> (TimeSymbol -> TimeSymbol -> Bool)
-> (TimeSymbol -> TimeSymbol -> TimeSymbol)
-> (TimeSymbol -> TimeSymbol -> TimeSymbol)
-> Ord TimeSymbol
TimeSymbol -> TimeSymbol -> Bool
TimeSymbol -> TimeSymbol -> Ordering
TimeSymbol -> TimeSymbol -> TimeSymbol
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeSymbol -> TimeSymbol -> TimeSymbol
$cmin :: TimeSymbol -> TimeSymbol -> TimeSymbol
max :: TimeSymbol -> TimeSymbol -> TimeSymbol
$cmax :: TimeSymbol -> TimeSymbol -> TimeSymbol
>= :: TimeSymbol -> TimeSymbol -> Bool
$c>= :: TimeSymbol -> TimeSymbol -> Bool
> :: TimeSymbol -> TimeSymbol -> Bool
$c> :: TimeSymbol -> TimeSymbol -> Bool
<= :: TimeSymbol -> TimeSymbol -> Bool
$c<= :: TimeSymbol -> TimeSymbol -> Bool
< :: TimeSymbol -> TimeSymbol -> Bool
$c< :: TimeSymbol -> TimeSymbol -> Bool
compare :: TimeSymbol -> TimeSymbol -> Ordering
$ccompare :: TimeSymbol -> TimeSymbol -> Ordering
$cp1Ord :: Eq TimeSymbol
Ord,Int -> TimeSymbol
TimeSymbol -> Int
TimeSymbol -> [TimeSymbol]
TimeSymbol -> TimeSymbol
TimeSymbol -> TimeSymbol -> [TimeSymbol]
TimeSymbol -> TimeSymbol -> TimeSymbol -> [TimeSymbol]
(TimeSymbol -> TimeSymbol)
-> (TimeSymbol -> TimeSymbol)
-> (Int -> TimeSymbol)
-> (TimeSymbol -> Int)
-> (TimeSymbol -> [TimeSymbol])
-> (TimeSymbol -> TimeSymbol -> [TimeSymbol])
-> (TimeSymbol -> TimeSymbol -> [TimeSymbol])
-> (TimeSymbol -> TimeSymbol -> TimeSymbol -> [TimeSymbol])
-> Enum TimeSymbol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TimeSymbol -> TimeSymbol -> TimeSymbol -> [TimeSymbol]
$cenumFromThenTo :: TimeSymbol -> TimeSymbol -> TimeSymbol -> [TimeSymbol]
enumFromTo :: TimeSymbol -> TimeSymbol -> [TimeSymbol]
$cenumFromTo :: TimeSymbol -> TimeSymbol -> [TimeSymbol]
enumFromThen :: TimeSymbol -> TimeSymbol -> [TimeSymbol]
$cenumFromThen :: TimeSymbol -> TimeSymbol -> [TimeSymbol]
enumFrom :: TimeSymbol -> [TimeSymbol]
$cenumFrom :: TimeSymbol -> [TimeSymbol]
fromEnum :: TimeSymbol -> Int
$cfromEnum :: TimeSymbol -> Int
toEnum :: Int -> TimeSymbol
$ctoEnum :: Int -> TimeSymbol
pred :: TimeSymbol -> TimeSymbol
$cpred :: TimeSymbol -> TimeSymbol
succ :: TimeSymbol -> TimeSymbol
$csucc :: TimeSymbol -> TimeSymbol
Enum,TimeSymbol
TimeSymbol -> TimeSymbol -> Bounded TimeSymbol
forall a. a -> a -> Bounded a
maxBound :: TimeSymbol
$cmaxBound :: TimeSymbol
minBound :: TimeSymbol
$cminBound :: TimeSymbol
Bounded)
instance EmitXml TimeSymbol where
    emitXml :: TimeSymbol -> XmlRep
emitXml TimeSymbol
TimeSymbolCommon = String -> XmlRep
XLit String
"common"
    emitXml TimeSymbol
TimeSymbolCut = String -> XmlRep
XLit String
"cut"
    emitXml TimeSymbol
TimeSymbolSingleNumber = String -> XmlRep
XLit String
"single-number"
    emitXml TimeSymbol
TimeSymbolNote = String -> XmlRep
XLit String
"note"
    emitXml TimeSymbol
TimeSymbolDottedNote = String -> XmlRep
XLit String
"dotted-note"
    emitXml TimeSymbol
TimeSymbolNormal = String -> XmlRep
XLit String
"normal"
parseTimeSymbol :: String -> P.XParse TimeSymbol
parseTimeSymbol :: String -> XParse TimeSymbol
parseTimeSymbol String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"common" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolCommon
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cut" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolCut
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single-number" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolSingleNumber
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"note" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolNote
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dotted-note" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolDottedNote
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = TimeSymbol -> XParse TimeSymbol
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeSymbol -> XParse TimeSymbol)
-> TimeSymbol -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ TimeSymbol
TimeSymbolNormal
        | Bool
otherwise = String -> XParse TimeSymbol
forall a. String -> XParse a
P.xfail (String -> XParse TimeSymbol) -> String -> XParse TimeSymbol
forall a b. (a -> b) -> a -> b
$ String
"TimeSymbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @tip-direction@ /(simple)/
--
-- The tip-direction type represents the direction in which the tip of a stick or beater points, using Unicode arrow terminology.
data TipDirection = 
      TipDirectionUp -- ^ /up/
    | TipDirectionDown -- ^ /down/
    | TipDirectionLeft -- ^ /left/
    | TipDirectionRight -- ^ /right/
    | TipDirectionNorthwest -- ^ /northwest/
    | TipDirectionNortheast -- ^ /northeast/
    | TipDirectionSoutheast -- ^ /southeast/
    | TipDirectionSouthwest -- ^ /southwest/
    deriving (TipDirection -> TipDirection -> Bool
(TipDirection -> TipDirection -> Bool)
-> (TipDirection -> TipDirection -> Bool) -> Eq TipDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TipDirection -> TipDirection -> Bool
$c/= :: TipDirection -> TipDirection -> Bool
== :: TipDirection -> TipDirection -> Bool
$c== :: TipDirection -> TipDirection -> Bool
Eq,Typeable,(forall x. TipDirection -> Rep TipDirection x)
-> (forall x. Rep TipDirection x -> TipDirection)
-> Generic TipDirection
forall x. Rep TipDirection x -> TipDirection
forall x. TipDirection -> Rep TipDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TipDirection x -> TipDirection
$cfrom :: forall x. TipDirection -> Rep TipDirection x
Generic,Int -> TipDirection -> ShowS
[TipDirection] -> ShowS
TipDirection -> String
(Int -> TipDirection -> ShowS)
-> (TipDirection -> String)
-> ([TipDirection] -> ShowS)
-> Show TipDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TipDirection] -> ShowS
$cshowList :: [TipDirection] -> ShowS
show :: TipDirection -> String
$cshow :: TipDirection -> String
showsPrec :: Int -> TipDirection -> ShowS
$cshowsPrec :: Int -> TipDirection -> ShowS
Show,Eq TipDirection
Eq TipDirection
-> (TipDirection -> TipDirection -> Ordering)
-> (TipDirection -> TipDirection -> Bool)
-> (TipDirection -> TipDirection -> Bool)
-> (TipDirection -> TipDirection -> Bool)
-> (TipDirection -> TipDirection -> Bool)
-> (TipDirection -> TipDirection -> TipDirection)
-> (TipDirection -> TipDirection -> TipDirection)
-> Ord TipDirection
TipDirection -> TipDirection -> Bool
TipDirection -> TipDirection -> Ordering
TipDirection -> TipDirection -> TipDirection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TipDirection -> TipDirection -> TipDirection
$cmin :: TipDirection -> TipDirection -> TipDirection
max :: TipDirection -> TipDirection -> TipDirection
$cmax :: TipDirection -> TipDirection -> TipDirection
>= :: TipDirection -> TipDirection -> Bool
$c>= :: TipDirection -> TipDirection -> Bool
> :: TipDirection -> TipDirection -> Bool
$c> :: TipDirection -> TipDirection -> Bool
<= :: TipDirection -> TipDirection -> Bool
$c<= :: TipDirection -> TipDirection -> Bool
< :: TipDirection -> TipDirection -> Bool
$c< :: TipDirection -> TipDirection -> Bool
compare :: TipDirection -> TipDirection -> Ordering
$ccompare :: TipDirection -> TipDirection -> Ordering
$cp1Ord :: Eq TipDirection
Ord,Int -> TipDirection
TipDirection -> Int
TipDirection -> [TipDirection]
TipDirection -> TipDirection
TipDirection -> TipDirection -> [TipDirection]
TipDirection -> TipDirection -> TipDirection -> [TipDirection]
(TipDirection -> TipDirection)
-> (TipDirection -> TipDirection)
-> (Int -> TipDirection)
-> (TipDirection -> Int)
-> (TipDirection -> [TipDirection])
-> (TipDirection -> TipDirection -> [TipDirection])
-> (TipDirection -> TipDirection -> [TipDirection])
-> (TipDirection -> TipDirection -> TipDirection -> [TipDirection])
-> Enum TipDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TipDirection -> TipDirection -> TipDirection -> [TipDirection]
$cenumFromThenTo :: TipDirection -> TipDirection -> TipDirection -> [TipDirection]
enumFromTo :: TipDirection -> TipDirection -> [TipDirection]
$cenumFromTo :: TipDirection -> TipDirection -> [TipDirection]
enumFromThen :: TipDirection -> TipDirection -> [TipDirection]
$cenumFromThen :: TipDirection -> TipDirection -> [TipDirection]
enumFrom :: TipDirection -> [TipDirection]
$cenumFrom :: TipDirection -> [TipDirection]
fromEnum :: TipDirection -> Int
$cfromEnum :: TipDirection -> Int
toEnum :: Int -> TipDirection
$ctoEnum :: Int -> TipDirection
pred :: TipDirection -> TipDirection
$cpred :: TipDirection -> TipDirection
succ :: TipDirection -> TipDirection
$csucc :: TipDirection -> TipDirection
Enum,TipDirection
TipDirection -> TipDirection -> Bounded TipDirection
forall a. a -> a -> Bounded a
maxBound :: TipDirection
$cmaxBound :: TipDirection
minBound :: TipDirection
$cminBound :: TipDirection
Bounded)
instance EmitXml TipDirection where
    emitXml :: TipDirection -> XmlRep
emitXml TipDirection
TipDirectionUp = String -> XmlRep
XLit String
"up"
    emitXml TipDirection
TipDirectionDown = String -> XmlRep
XLit String
"down"
    emitXml TipDirection
TipDirectionLeft = String -> XmlRep
XLit String
"left"
    emitXml TipDirection
TipDirectionRight = String -> XmlRep
XLit String
"right"
    emitXml TipDirection
TipDirectionNorthwest = String -> XmlRep
XLit String
"northwest"
    emitXml TipDirection
TipDirectionNortheast = String -> XmlRep
XLit String
"northeast"
    emitXml TipDirection
TipDirectionSoutheast = String -> XmlRep
XLit String
"southeast"
    emitXml TipDirection
TipDirectionSouthwest = String -> XmlRep
XLit String
"southwest"
parseTipDirection :: String -> P.XParse TipDirection
parseTipDirection :: String -> XParse TipDirection
parseTipDirection String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"left" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionLeft
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"right" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionRight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northwest" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionNorthwest
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"northeast" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionNortheast
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"southeast" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionSoutheast
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"southwest" = TipDirection -> XParse TipDirection
forall (m :: * -> *) a. Monad m => a -> m a
return (TipDirection -> XParse TipDirection)
-> TipDirection -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ TipDirection
TipDirectionSouthwest
        | Bool
otherwise = String -> XParse TipDirection
forall a. String -> XParse a
P.xfail (String -> XParse TipDirection) -> String -> XParse TipDirection
forall a b. (a -> b) -> a -> b
$ String
"TipDirection: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @xs:token@ /(simple)/
newtype Token = Token { Token -> NormalizedString
token :: NormalizedString }
    deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq,Typeable,(forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Token x -> Token
$cfrom :: forall x. Token -> Rep Token x
Generic,Eq Token
Eq Token
-> (Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
$cp1Ord :: Eq Token
Ord,String -> Token
(String -> Token) -> IsString Token
forall a. (String -> a) -> IsString a
fromString :: String -> Token
$cfromString :: String -> Token
IsString)
instance Show Token where show :: Token -> String
show (Token NormalizedString
a) = NormalizedString -> String
forall a. Show a => a -> String
show NormalizedString
a
instance Read Token where readsPrec :: Int -> String -> [(Token, String)]
readsPrec Int
i = ((NormalizedString, String) -> (Token, String))
-> [(NormalizedString, String)] -> [(Token, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((NormalizedString -> Token)
-> (NormalizedString, String) -> (Token, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first NormalizedString -> Token
Token) ([(NormalizedString, String)] -> [(Token, String)])
-> ReadS NormalizedString -> String -> [(Token, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadS NormalizedString
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml Token where
    emitXml :: Token -> XmlRep
emitXml = NormalizedString -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (NormalizedString -> XmlRep)
-> (Token -> NormalizedString) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> NormalizedString
token
parseToken :: String -> P.XParse Token
parseToken :: String -> XParse Token
parseToken = Token -> XParse Token
forall (m :: * -> *) a. Monad m => a -> m a
return (Token -> XParse Token)
-> (String -> Token) -> String -> XParse Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Token
forall a. IsString a => String -> a
fromString

-- | @top-bottom@ /(simple)/
--
-- The top-bottom type is used to indicate the top or bottom part of a vertical shape like non-arpeggiate.
data TopBottom = 
      TopBottomTop -- ^ /top/
    | TopBottomBottom -- ^ /bottom/
    deriving (TopBottom -> TopBottom -> Bool
(TopBottom -> TopBottom -> Bool)
-> (TopBottom -> TopBottom -> Bool) -> Eq TopBottom
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TopBottom -> TopBottom -> Bool
$c/= :: TopBottom -> TopBottom -> Bool
== :: TopBottom -> TopBottom -> Bool
$c== :: TopBottom -> TopBottom -> Bool
Eq,Typeable,(forall x. TopBottom -> Rep TopBottom x)
-> (forall x. Rep TopBottom x -> TopBottom) -> Generic TopBottom
forall x. Rep TopBottom x -> TopBottom
forall x. TopBottom -> Rep TopBottom x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TopBottom x -> TopBottom
$cfrom :: forall x. TopBottom -> Rep TopBottom x
Generic,Int -> TopBottom -> ShowS
[TopBottom] -> ShowS
TopBottom -> String
(Int -> TopBottom -> ShowS)
-> (TopBottom -> String)
-> ([TopBottom] -> ShowS)
-> Show TopBottom
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TopBottom] -> ShowS
$cshowList :: [TopBottom] -> ShowS
show :: TopBottom -> String
$cshow :: TopBottom -> String
showsPrec :: Int -> TopBottom -> ShowS
$cshowsPrec :: Int -> TopBottom -> ShowS
Show,Eq TopBottom
Eq TopBottom
-> (TopBottom -> TopBottom -> Ordering)
-> (TopBottom -> TopBottom -> Bool)
-> (TopBottom -> TopBottom -> Bool)
-> (TopBottom -> TopBottom -> Bool)
-> (TopBottom -> TopBottom -> Bool)
-> (TopBottom -> TopBottom -> TopBottom)
-> (TopBottom -> TopBottom -> TopBottom)
-> Ord TopBottom
TopBottom -> TopBottom -> Bool
TopBottom -> TopBottom -> Ordering
TopBottom -> TopBottom -> TopBottom
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TopBottom -> TopBottom -> TopBottom
$cmin :: TopBottom -> TopBottom -> TopBottom
max :: TopBottom -> TopBottom -> TopBottom
$cmax :: TopBottom -> TopBottom -> TopBottom
>= :: TopBottom -> TopBottom -> Bool
$c>= :: TopBottom -> TopBottom -> Bool
> :: TopBottom -> TopBottom -> Bool
$c> :: TopBottom -> TopBottom -> Bool
<= :: TopBottom -> TopBottom -> Bool
$c<= :: TopBottom -> TopBottom -> Bool
< :: TopBottom -> TopBottom -> Bool
$c< :: TopBottom -> TopBottom -> Bool
compare :: TopBottom -> TopBottom -> Ordering
$ccompare :: TopBottom -> TopBottom -> Ordering
$cp1Ord :: Eq TopBottom
Ord,Int -> TopBottom
TopBottom -> Int
TopBottom -> [TopBottom]
TopBottom -> TopBottom
TopBottom -> TopBottom -> [TopBottom]
TopBottom -> TopBottom -> TopBottom -> [TopBottom]
(TopBottom -> TopBottom)
-> (TopBottom -> TopBottom)
-> (Int -> TopBottom)
-> (TopBottom -> Int)
-> (TopBottom -> [TopBottom])
-> (TopBottom -> TopBottom -> [TopBottom])
-> (TopBottom -> TopBottom -> [TopBottom])
-> (TopBottom -> TopBottom -> TopBottom -> [TopBottom])
-> Enum TopBottom
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TopBottom -> TopBottom -> TopBottom -> [TopBottom]
$cenumFromThenTo :: TopBottom -> TopBottom -> TopBottom -> [TopBottom]
enumFromTo :: TopBottom -> TopBottom -> [TopBottom]
$cenumFromTo :: TopBottom -> TopBottom -> [TopBottom]
enumFromThen :: TopBottom -> TopBottom -> [TopBottom]
$cenumFromThen :: TopBottom -> TopBottom -> [TopBottom]
enumFrom :: TopBottom -> [TopBottom]
$cenumFrom :: TopBottom -> [TopBottom]
fromEnum :: TopBottom -> Int
$cfromEnum :: TopBottom -> Int
toEnum :: Int -> TopBottom
$ctoEnum :: Int -> TopBottom
pred :: TopBottom -> TopBottom
$cpred :: TopBottom -> TopBottom
succ :: TopBottom -> TopBottom
$csucc :: TopBottom -> TopBottom
Enum,TopBottom
TopBottom -> TopBottom -> Bounded TopBottom
forall a. a -> a -> Bounded a
maxBound :: TopBottom
$cmaxBound :: TopBottom
minBound :: TopBottom
$cminBound :: TopBottom
Bounded)
instance EmitXml TopBottom where
    emitXml :: TopBottom -> XmlRep
emitXml TopBottom
TopBottomTop = String -> XmlRep
XLit String
"top"
    emitXml TopBottom
TopBottomBottom = String -> XmlRep
XLit String
"bottom"
parseTopBottom :: String -> P.XParse TopBottom
parseTopBottom :: String -> XParse TopBottom
parseTopBottom String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"top" = TopBottom -> XParse TopBottom
forall (m :: * -> *) a. Monad m => a -> m a
return (TopBottom -> XParse TopBottom) -> TopBottom -> XParse TopBottom
forall a b. (a -> b) -> a -> b
$ TopBottom
TopBottomTop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bottom" = TopBottom -> XParse TopBottom
forall (m :: * -> *) a. Monad m => a -> m a
return (TopBottom -> XParse TopBottom) -> TopBottom -> XParse TopBottom
forall a b. (a -> b) -> a -> b
$ TopBottom
TopBottomBottom
        | Bool
otherwise = String -> XParse TopBottom
forall a. String -> XParse a
P.xfail (String -> XParse TopBottom) -> String -> XParse TopBottom
forall a b. (a -> b) -> a -> b
$ String
"TopBottom: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @tremolo-marks@ /(simple)/
--
-- The number of tremolo marks is represented by a number from 0 to 8: the same as beam-level with 0 added.
newtype TremoloMarks = TremoloMarks { TremoloMarks -> Int
tremoloMarks :: Int }
    deriving (TremoloMarks -> TremoloMarks -> Bool
(TremoloMarks -> TremoloMarks -> Bool)
-> (TremoloMarks -> TremoloMarks -> Bool) -> Eq TremoloMarks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TremoloMarks -> TremoloMarks -> Bool
$c/= :: TremoloMarks -> TremoloMarks -> Bool
== :: TremoloMarks -> TremoloMarks -> Bool
$c== :: TremoloMarks -> TremoloMarks -> Bool
Eq,Typeable,(forall x. TremoloMarks -> Rep TremoloMarks x)
-> (forall x. Rep TremoloMarks x -> TremoloMarks)
-> Generic TremoloMarks
forall x. Rep TremoloMarks x -> TremoloMarks
forall x. TremoloMarks -> Rep TremoloMarks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TremoloMarks x -> TremoloMarks
$cfrom :: forall x. TremoloMarks -> Rep TremoloMarks x
Generic,Eq TremoloMarks
Eq TremoloMarks
-> (TremoloMarks -> TremoloMarks -> Ordering)
-> (TremoloMarks -> TremoloMarks -> Bool)
-> (TremoloMarks -> TremoloMarks -> Bool)
-> (TremoloMarks -> TremoloMarks -> Bool)
-> (TremoloMarks -> TremoloMarks -> Bool)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> Ord TremoloMarks
TremoloMarks -> TremoloMarks -> Bool
TremoloMarks -> TremoloMarks -> Ordering
TremoloMarks -> TremoloMarks -> TremoloMarks
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cmin :: TremoloMarks -> TremoloMarks -> TremoloMarks
max :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cmax :: TremoloMarks -> TremoloMarks -> TremoloMarks
>= :: TremoloMarks -> TremoloMarks -> Bool
$c>= :: TremoloMarks -> TremoloMarks -> Bool
> :: TremoloMarks -> TremoloMarks -> Bool
$c> :: TremoloMarks -> TremoloMarks -> Bool
<= :: TremoloMarks -> TremoloMarks -> Bool
$c<= :: TremoloMarks -> TremoloMarks -> Bool
< :: TremoloMarks -> TremoloMarks -> Bool
$c< :: TremoloMarks -> TremoloMarks -> Bool
compare :: TremoloMarks -> TremoloMarks -> Ordering
$ccompare :: TremoloMarks -> TremoloMarks -> Ordering
$cp1Ord :: Eq TremoloMarks
Ord,TremoloMarks
TremoloMarks -> TremoloMarks -> Bounded TremoloMarks
forall a. a -> a -> Bounded a
maxBound :: TremoloMarks
$cmaxBound :: TremoloMarks
minBound :: TremoloMarks
$cminBound :: TremoloMarks
Bounded,Int -> TremoloMarks
TremoloMarks -> Int
TremoloMarks -> [TremoloMarks]
TremoloMarks -> TremoloMarks
TremoloMarks -> TremoloMarks -> [TremoloMarks]
TremoloMarks -> TremoloMarks -> TremoloMarks -> [TremoloMarks]
(TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks)
-> (Int -> TremoloMarks)
-> (TremoloMarks -> Int)
-> (TremoloMarks -> [TremoloMarks])
-> (TremoloMarks -> TremoloMarks -> [TremoloMarks])
-> (TremoloMarks -> TremoloMarks -> [TremoloMarks])
-> (TremoloMarks -> TremoloMarks -> TremoloMarks -> [TremoloMarks])
-> Enum TremoloMarks
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TremoloMarks -> TremoloMarks -> TremoloMarks -> [TremoloMarks]
$cenumFromThenTo :: TremoloMarks -> TremoloMarks -> TremoloMarks -> [TremoloMarks]
enumFromTo :: TremoloMarks -> TremoloMarks -> [TremoloMarks]
$cenumFromTo :: TremoloMarks -> TremoloMarks -> [TremoloMarks]
enumFromThen :: TremoloMarks -> TremoloMarks -> [TremoloMarks]
$cenumFromThen :: TremoloMarks -> TremoloMarks -> [TremoloMarks]
enumFrom :: TremoloMarks -> [TremoloMarks]
$cenumFrom :: TremoloMarks -> [TremoloMarks]
fromEnum :: TremoloMarks -> Int
$cfromEnum :: TremoloMarks -> Int
toEnum :: Int -> TremoloMarks
$ctoEnum :: Int -> TremoloMarks
pred :: TremoloMarks -> TremoloMarks
$cpred :: TremoloMarks -> TremoloMarks
succ :: TremoloMarks -> TremoloMarks
$csucc :: TremoloMarks -> TremoloMarks
Enum,Integer -> TremoloMarks
TremoloMarks -> TremoloMarks
TremoloMarks -> TremoloMarks -> TremoloMarks
(TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks)
-> (Integer -> TremoloMarks)
-> Num TremoloMarks
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TremoloMarks
$cfromInteger :: Integer -> TremoloMarks
signum :: TremoloMarks -> TremoloMarks
$csignum :: TremoloMarks -> TremoloMarks
abs :: TremoloMarks -> TremoloMarks
$cabs :: TremoloMarks -> TremoloMarks
negate :: TremoloMarks -> TremoloMarks
$cnegate :: TremoloMarks -> TremoloMarks
* :: TremoloMarks -> TremoloMarks -> TremoloMarks
$c* :: TremoloMarks -> TremoloMarks -> TremoloMarks
- :: TremoloMarks -> TremoloMarks -> TremoloMarks
$c- :: TremoloMarks -> TremoloMarks -> TremoloMarks
+ :: TremoloMarks -> TremoloMarks -> TremoloMarks
$c+ :: TremoloMarks -> TremoloMarks -> TremoloMarks
Num,Num TremoloMarks
Ord TremoloMarks
Num TremoloMarks
-> Ord TremoloMarks
-> (TremoloMarks -> Rational)
-> Real TremoloMarks
TremoloMarks -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: TremoloMarks -> Rational
$ctoRational :: TremoloMarks -> Rational
$cp2Real :: Ord TremoloMarks
$cp1Real :: Num TremoloMarks
Real,Enum TremoloMarks
Real TremoloMarks
Real TremoloMarks
-> Enum TremoloMarks
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> TremoloMarks)
-> (TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks))
-> (TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks))
-> (TremoloMarks -> Integer)
-> Integral TremoloMarks
TremoloMarks -> Integer
TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks)
TremoloMarks -> TremoloMarks -> TremoloMarks
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: TremoloMarks -> Integer
$ctoInteger :: TremoloMarks -> Integer
divMod :: TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks)
$cdivMod :: TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks)
quotRem :: TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks)
$cquotRem :: TremoloMarks -> TremoloMarks -> (TremoloMarks, TremoloMarks)
mod :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cmod :: TremoloMarks -> TremoloMarks -> TremoloMarks
div :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cdiv :: TremoloMarks -> TremoloMarks -> TremoloMarks
rem :: TremoloMarks -> TremoloMarks -> TremoloMarks
$crem :: TremoloMarks -> TremoloMarks -> TremoloMarks
quot :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cquot :: TremoloMarks -> TremoloMarks -> TremoloMarks
$cp2Integral :: Enum TremoloMarks
$cp1Integral :: Real TremoloMarks
Integral)
instance Show TremoloMarks where show :: TremoloMarks -> String
show (TremoloMarks Int
a) = Int -> String
forall a. Show a => a -> String
show Int
a
instance Read TremoloMarks where readsPrec :: Int -> ReadS TremoloMarks
readsPrec Int
i = ((Int, String) -> (TremoloMarks, String))
-> [(Int, String)] -> [(TremoloMarks, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> TremoloMarks) -> (Int, String) -> (TremoloMarks, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Int -> TremoloMarks
TremoloMarks) ([(Int, String)] -> [(TremoloMarks, String)])
-> (String -> [(Int, String)]) -> ReadS TremoloMarks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Int, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml TremoloMarks where
    emitXml :: TremoloMarks -> XmlRep
emitXml = Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Int -> XmlRep) -> (TremoloMarks -> Int) -> TremoloMarks -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TremoloMarks -> Int
tremoloMarks
parseTremoloMarks :: String -> P.XParse TremoloMarks
parseTremoloMarks :: String -> XParse TremoloMarks
parseTremoloMarks = String -> String -> XParse TremoloMarks
forall a. Read a => String -> String -> XParse a
P.xread String
"TremoloMarks"

-- | @tremolo-type@ /(simple)/
--
-- The tremolo-type is used to distinguish multi-note, single-note, and unmeasured tremolos.
data TremoloType = 
      TremoloTypeStart -- ^ /start/
    | TremoloTypeStop -- ^ /stop/
    | TremoloTypeSingle -- ^ /single/
    | TremoloTypeUnmeasured -- ^ /unmeasured/
    deriving (TremoloType -> TremoloType -> Bool
(TremoloType -> TremoloType -> Bool)
-> (TremoloType -> TremoloType -> Bool) -> Eq TremoloType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TremoloType -> TremoloType -> Bool
$c/= :: TremoloType -> TremoloType -> Bool
== :: TremoloType -> TremoloType -> Bool
$c== :: TremoloType -> TremoloType -> Bool
Eq,Typeable,(forall x. TremoloType -> Rep TremoloType x)
-> (forall x. Rep TremoloType x -> TremoloType)
-> Generic TremoloType
forall x. Rep TremoloType x -> TremoloType
forall x. TremoloType -> Rep TremoloType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TremoloType x -> TremoloType
$cfrom :: forall x. TremoloType -> Rep TremoloType x
Generic,Int -> TremoloType -> ShowS
[TremoloType] -> ShowS
TremoloType -> String
(Int -> TremoloType -> ShowS)
-> (TremoloType -> String)
-> ([TremoloType] -> ShowS)
-> Show TremoloType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TremoloType] -> ShowS
$cshowList :: [TremoloType] -> ShowS
show :: TremoloType -> String
$cshow :: TremoloType -> String
showsPrec :: Int -> TremoloType -> ShowS
$cshowsPrec :: Int -> TremoloType -> ShowS
Show,Eq TremoloType
Eq TremoloType
-> (TremoloType -> TremoloType -> Ordering)
-> (TremoloType -> TremoloType -> Bool)
-> (TremoloType -> TremoloType -> Bool)
-> (TremoloType -> TremoloType -> Bool)
-> (TremoloType -> TremoloType -> Bool)
-> (TremoloType -> TremoloType -> TremoloType)
-> (TremoloType -> TremoloType -> TremoloType)
-> Ord TremoloType
TremoloType -> TremoloType -> Bool
TremoloType -> TremoloType -> Ordering
TremoloType -> TremoloType -> TremoloType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TremoloType -> TremoloType -> TremoloType
$cmin :: TremoloType -> TremoloType -> TremoloType
max :: TremoloType -> TremoloType -> TremoloType
$cmax :: TremoloType -> TremoloType -> TremoloType
>= :: TremoloType -> TremoloType -> Bool
$c>= :: TremoloType -> TremoloType -> Bool
> :: TremoloType -> TremoloType -> Bool
$c> :: TremoloType -> TremoloType -> Bool
<= :: TremoloType -> TremoloType -> Bool
$c<= :: TremoloType -> TremoloType -> Bool
< :: TremoloType -> TremoloType -> Bool
$c< :: TremoloType -> TremoloType -> Bool
compare :: TremoloType -> TremoloType -> Ordering
$ccompare :: TremoloType -> TremoloType -> Ordering
$cp1Ord :: Eq TremoloType
Ord,Int -> TremoloType
TremoloType -> Int
TremoloType -> [TremoloType]
TremoloType -> TremoloType
TremoloType -> TremoloType -> [TremoloType]
TremoloType -> TremoloType -> TremoloType -> [TremoloType]
(TremoloType -> TremoloType)
-> (TremoloType -> TremoloType)
-> (Int -> TremoloType)
-> (TremoloType -> Int)
-> (TremoloType -> [TremoloType])
-> (TremoloType -> TremoloType -> [TremoloType])
-> (TremoloType -> TremoloType -> [TremoloType])
-> (TremoloType -> TremoloType -> TremoloType -> [TremoloType])
-> Enum TremoloType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TremoloType -> TremoloType -> TremoloType -> [TremoloType]
$cenumFromThenTo :: TremoloType -> TremoloType -> TremoloType -> [TremoloType]
enumFromTo :: TremoloType -> TremoloType -> [TremoloType]
$cenumFromTo :: TremoloType -> TremoloType -> [TremoloType]
enumFromThen :: TremoloType -> TremoloType -> [TremoloType]
$cenumFromThen :: TremoloType -> TremoloType -> [TremoloType]
enumFrom :: TremoloType -> [TremoloType]
$cenumFrom :: TremoloType -> [TremoloType]
fromEnum :: TremoloType -> Int
$cfromEnum :: TremoloType -> Int
toEnum :: Int -> TremoloType
$ctoEnum :: Int -> TremoloType
pred :: TremoloType -> TremoloType
$cpred :: TremoloType -> TremoloType
succ :: TremoloType -> TremoloType
$csucc :: TremoloType -> TremoloType
Enum,TremoloType
TremoloType -> TremoloType -> Bounded TremoloType
forall a. a -> a -> Bounded a
maxBound :: TremoloType
$cmaxBound :: TremoloType
minBound :: TremoloType
$cminBound :: TremoloType
Bounded)
instance EmitXml TremoloType where
    emitXml :: TremoloType -> XmlRep
emitXml TremoloType
TremoloTypeStart = String -> XmlRep
XLit String
"start"
    emitXml TremoloType
TremoloTypeStop = String -> XmlRep
XLit String
"stop"
    emitXml TremoloType
TremoloTypeSingle = String -> XmlRep
XLit String
"single"
    emitXml TremoloType
TremoloTypeUnmeasured = String -> XmlRep
XLit String
"unmeasured"
parseTremoloType :: String -> P.XParse TremoloType
parseTremoloType :: String -> XParse TremoloType
parseTremoloType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"start" = TremoloType -> XParse TremoloType
forall (m :: * -> *) a. Monad m => a -> m a
return (TremoloType -> XParse TremoloType)
-> TremoloType -> XParse TremoloType
forall a b. (a -> b) -> a -> b
$ TremoloType
TremoloTypeStart
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = TremoloType -> XParse TremoloType
forall (m :: * -> *) a. Monad m => a -> m a
return (TremoloType -> XParse TremoloType)
-> TremoloType -> XParse TremoloType
forall a b. (a -> b) -> a -> b
$ TremoloType
TremoloTypeStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"single" = TremoloType -> XParse TremoloType
forall (m :: * -> *) a. Monad m => a -> m a
return (TremoloType -> XParse TremoloType)
-> TremoloType -> XParse TremoloType
forall a b. (a -> b) -> a -> b
$ TremoloType
TremoloTypeSingle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"unmeasured" = TremoloType -> XParse TremoloType
forall (m :: * -> *) a. Monad m => a -> m a
return (TremoloType -> XParse TremoloType)
-> TremoloType -> XParse TremoloType
forall a b. (a -> b) -> a -> b
$ TremoloType
TremoloTypeUnmeasured
        | Bool
otherwise = String -> XParse TremoloType
forall a. String -> XParse a
P.xfail (String -> XParse TremoloType) -> String -> XParse TremoloType
forall a b. (a -> b) -> a -> b
$ String
"TremoloType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @trill-beats@ /(simple)/
--
-- The trill-beats type specifies the beats used in a trill-sound or bend-sound attribute group. It is a decimal value with a minimum value of 2.
newtype TrillBeats = TrillBeats { TrillBeats -> Decimal
trillBeats :: Decimal }
    deriving (TrillBeats -> TrillBeats -> Bool
(TrillBeats -> TrillBeats -> Bool)
-> (TrillBeats -> TrillBeats -> Bool) -> Eq TrillBeats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrillBeats -> TrillBeats -> Bool
$c/= :: TrillBeats -> TrillBeats -> Bool
== :: TrillBeats -> TrillBeats -> Bool
$c== :: TrillBeats -> TrillBeats -> Bool
Eq,Typeable,(forall x. TrillBeats -> Rep TrillBeats x)
-> (forall x. Rep TrillBeats x -> TrillBeats) -> Generic TrillBeats
forall x. Rep TrillBeats x -> TrillBeats
forall x. TrillBeats -> Rep TrillBeats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrillBeats x -> TrillBeats
$cfrom :: forall x. TrillBeats -> Rep TrillBeats x
Generic,Eq TrillBeats
Eq TrillBeats
-> (TrillBeats -> TrillBeats -> Ordering)
-> (TrillBeats -> TrillBeats -> Bool)
-> (TrillBeats -> TrillBeats -> Bool)
-> (TrillBeats -> TrillBeats -> Bool)
-> (TrillBeats -> TrillBeats -> Bool)
-> (TrillBeats -> TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats -> TrillBeats)
-> Ord TrillBeats
TrillBeats -> TrillBeats -> Bool
TrillBeats -> TrillBeats -> Ordering
TrillBeats -> TrillBeats -> TrillBeats
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TrillBeats -> TrillBeats -> TrillBeats
$cmin :: TrillBeats -> TrillBeats -> TrillBeats
max :: TrillBeats -> TrillBeats -> TrillBeats
$cmax :: TrillBeats -> TrillBeats -> TrillBeats
>= :: TrillBeats -> TrillBeats -> Bool
$c>= :: TrillBeats -> TrillBeats -> Bool
> :: TrillBeats -> TrillBeats -> Bool
$c> :: TrillBeats -> TrillBeats -> Bool
<= :: TrillBeats -> TrillBeats -> Bool
$c<= :: TrillBeats -> TrillBeats -> Bool
< :: TrillBeats -> TrillBeats -> Bool
$c< :: TrillBeats -> TrillBeats -> Bool
compare :: TrillBeats -> TrillBeats -> Ordering
$ccompare :: TrillBeats -> TrillBeats -> Ordering
$cp1Ord :: Eq TrillBeats
Ord,Integer -> TrillBeats
TrillBeats -> TrillBeats
TrillBeats -> TrillBeats -> TrillBeats
(TrillBeats -> TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats)
-> (Integer -> TrillBeats)
-> Num TrillBeats
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TrillBeats
$cfromInteger :: Integer -> TrillBeats
signum :: TrillBeats -> TrillBeats
$csignum :: TrillBeats -> TrillBeats
abs :: TrillBeats -> TrillBeats
$cabs :: TrillBeats -> TrillBeats
negate :: TrillBeats -> TrillBeats
$cnegate :: TrillBeats -> TrillBeats
* :: TrillBeats -> TrillBeats -> TrillBeats
$c* :: TrillBeats -> TrillBeats -> TrillBeats
- :: TrillBeats -> TrillBeats -> TrillBeats
$c- :: TrillBeats -> TrillBeats -> TrillBeats
+ :: TrillBeats -> TrillBeats -> TrillBeats
$c+ :: TrillBeats -> TrillBeats -> TrillBeats
Num,Num TrillBeats
Ord TrillBeats
Num TrillBeats
-> Ord TrillBeats -> (TrillBeats -> Rational) -> Real TrillBeats
TrillBeats -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: TrillBeats -> Rational
$ctoRational :: TrillBeats -> Rational
$cp2Real :: Ord TrillBeats
$cp1Real :: Num TrillBeats
Real,Num TrillBeats
Num TrillBeats
-> (TrillBeats -> TrillBeats -> TrillBeats)
-> (TrillBeats -> TrillBeats)
-> (Rational -> TrillBeats)
-> Fractional TrillBeats
Rational -> TrillBeats
TrillBeats -> TrillBeats
TrillBeats -> TrillBeats -> TrillBeats
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> TrillBeats
$cfromRational :: Rational -> TrillBeats
recip :: TrillBeats -> TrillBeats
$crecip :: TrillBeats -> TrillBeats
/ :: TrillBeats -> TrillBeats -> TrillBeats
$c/ :: TrillBeats -> TrillBeats -> TrillBeats
$cp1Fractional :: Num TrillBeats
Fractional,Fractional TrillBeats
Real TrillBeats
Real TrillBeats
-> Fractional TrillBeats
-> (forall b. Integral b => TrillBeats -> (b, TrillBeats))
-> (forall b. Integral b => TrillBeats -> b)
-> (forall b. Integral b => TrillBeats -> b)
-> (forall b. Integral b => TrillBeats -> b)
-> (forall b. Integral b => TrillBeats -> b)
-> RealFrac TrillBeats
TrillBeats -> b
TrillBeats -> b
TrillBeats -> b
TrillBeats -> b
TrillBeats -> (b, TrillBeats)
forall b. Integral b => TrillBeats -> b
forall b. Integral b => TrillBeats -> (b, TrillBeats)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: TrillBeats -> b
$cfloor :: forall b. Integral b => TrillBeats -> b
ceiling :: TrillBeats -> b
$cceiling :: forall b. Integral b => TrillBeats -> b
round :: TrillBeats -> b
$cround :: forall b. Integral b => TrillBeats -> b
truncate :: TrillBeats -> b
$ctruncate :: forall b. Integral b => TrillBeats -> b
properFraction :: TrillBeats -> (b, TrillBeats)
$cproperFraction :: forall b. Integral b => TrillBeats -> (b, TrillBeats)
$cp2RealFrac :: Fractional TrillBeats
$cp1RealFrac :: Real TrillBeats
RealFrac)
instance Show TrillBeats where show :: TrillBeats -> String
show (TrillBeats Decimal
a) = Decimal -> String
forall a. Show a => a -> String
show Decimal
a
instance Read TrillBeats where readsPrec :: Int -> ReadS TrillBeats
readsPrec Int
i = ((Decimal, String) -> (TrillBeats, String))
-> [(Decimal, String)] -> [(TrillBeats, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((Decimal -> TrillBeats)
-> (Decimal, String) -> (TrillBeats, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first Decimal -> TrillBeats
TrillBeats) ([(Decimal, String)] -> [(TrillBeats, String)])
-> (String -> [(Decimal, String)]) -> ReadS TrillBeats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(Decimal, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml TrillBeats where
    emitXml :: TrillBeats -> XmlRep
emitXml = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (Decimal -> XmlRep)
-> (TrillBeats -> Decimal) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TrillBeats -> Decimal
trillBeats
parseTrillBeats :: String -> P.XParse TrillBeats
parseTrillBeats :: String -> XParse TrillBeats
parseTrillBeats = String -> String -> XParse TrillBeats
forall a. Read a => String -> String -> XParse a
P.xread String
"TrillBeats"

-- | @trill-step@ /(simple)/
--
-- The trill-step type describes the alternating note of trills and mordents for playback, relative to the current note.
data TrillStep = 
      TrillStepWhole -- ^ /whole/
    | TrillStepHalf -- ^ /half/
    | TrillStepUnison -- ^ /unison/
    deriving (TrillStep -> TrillStep -> Bool
(TrillStep -> TrillStep -> Bool)
-> (TrillStep -> TrillStep -> Bool) -> Eq TrillStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrillStep -> TrillStep -> Bool
$c/= :: TrillStep -> TrillStep -> Bool
== :: TrillStep -> TrillStep -> Bool
$c== :: TrillStep -> TrillStep -> Bool
Eq,Typeable,(forall x. TrillStep -> Rep TrillStep x)
-> (forall x. Rep TrillStep x -> TrillStep) -> Generic TrillStep
forall x. Rep TrillStep x -> TrillStep
forall x. TrillStep -> Rep TrillStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrillStep x -> TrillStep
$cfrom :: forall x. TrillStep -> Rep TrillStep x
Generic,Int -> TrillStep -> ShowS
[TrillStep] -> ShowS
TrillStep -> String
(Int -> TrillStep -> ShowS)
-> (TrillStep -> String)
-> ([TrillStep] -> ShowS)
-> Show TrillStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrillStep] -> ShowS
$cshowList :: [TrillStep] -> ShowS
show :: TrillStep -> String
$cshow :: TrillStep -> String
showsPrec :: Int -> TrillStep -> ShowS
$cshowsPrec :: Int -> TrillStep -> ShowS
Show,Eq TrillStep
Eq TrillStep
-> (TrillStep -> TrillStep -> Ordering)
-> (TrillStep -> TrillStep -> Bool)
-> (TrillStep -> TrillStep -> Bool)
-> (TrillStep -> TrillStep -> Bool)
-> (TrillStep -> TrillStep -> Bool)
-> (TrillStep -> TrillStep -> TrillStep)
-> (TrillStep -> TrillStep -> TrillStep)
-> Ord TrillStep
TrillStep -> TrillStep -> Bool
TrillStep -> TrillStep -> Ordering
TrillStep -> TrillStep -> TrillStep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TrillStep -> TrillStep -> TrillStep
$cmin :: TrillStep -> TrillStep -> TrillStep
max :: TrillStep -> TrillStep -> TrillStep
$cmax :: TrillStep -> TrillStep -> TrillStep
>= :: TrillStep -> TrillStep -> Bool
$c>= :: TrillStep -> TrillStep -> Bool
> :: TrillStep -> TrillStep -> Bool
$c> :: TrillStep -> TrillStep -> Bool
<= :: TrillStep -> TrillStep -> Bool
$c<= :: TrillStep -> TrillStep -> Bool
< :: TrillStep -> TrillStep -> Bool
$c< :: TrillStep -> TrillStep -> Bool
compare :: TrillStep -> TrillStep -> Ordering
$ccompare :: TrillStep -> TrillStep -> Ordering
$cp1Ord :: Eq TrillStep
Ord,Int -> TrillStep
TrillStep -> Int
TrillStep -> [TrillStep]
TrillStep -> TrillStep
TrillStep -> TrillStep -> [TrillStep]
TrillStep -> TrillStep -> TrillStep -> [TrillStep]
(TrillStep -> TrillStep)
-> (TrillStep -> TrillStep)
-> (Int -> TrillStep)
-> (TrillStep -> Int)
-> (TrillStep -> [TrillStep])
-> (TrillStep -> TrillStep -> [TrillStep])
-> (TrillStep -> TrillStep -> [TrillStep])
-> (TrillStep -> TrillStep -> TrillStep -> [TrillStep])
-> Enum TrillStep
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TrillStep -> TrillStep -> TrillStep -> [TrillStep]
$cenumFromThenTo :: TrillStep -> TrillStep -> TrillStep -> [TrillStep]
enumFromTo :: TrillStep -> TrillStep -> [TrillStep]
$cenumFromTo :: TrillStep -> TrillStep -> [TrillStep]
enumFromThen :: TrillStep -> TrillStep -> [TrillStep]
$cenumFromThen :: TrillStep -> TrillStep -> [TrillStep]
enumFrom :: TrillStep -> [TrillStep]
$cenumFrom :: TrillStep -> [TrillStep]
fromEnum :: TrillStep -> Int
$cfromEnum :: TrillStep -> Int
toEnum :: Int -> TrillStep
$ctoEnum :: Int -> TrillStep
pred :: TrillStep -> TrillStep
$cpred :: TrillStep -> TrillStep
succ :: TrillStep -> TrillStep
$csucc :: TrillStep -> TrillStep
Enum,TrillStep
TrillStep -> TrillStep -> Bounded TrillStep
forall a. a -> a -> Bounded a
maxBound :: TrillStep
$cmaxBound :: TrillStep
minBound :: TrillStep
$cminBound :: TrillStep
Bounded)
instance EmitXml TrillStep where
    emitXml :: TrillStep -> XmlRep
emitXml TrillStep
TrillStepWhole = String -> XmlRep
XLit String
"whole"
    emitXml TrillStep
TrillStepHalf = String -> XmlRep
XLit String
"half"
    emitXml TrillStep
TrillStepUnison = String -> XmlRep
XLit String
"unison"
parseTrillStep :: String -> P.XParse TrillStep
parseTrillStep :: String -> XParse TrillStep
parseTrillStep String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"whole" = TrillStep -> XParse TrillStep
forall (m :: * -> *) a. Monad m => a -> m a
return (TrillStep -> XParse TrillStep) -> TrillStep -> XParse TrillStep
forall a b. (a -> b) -> a -> b
$ TrillStep
TrillStepWhole
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half" = TrillStep -> XParse TrillStep
forall (m :: * -> *) a. Monad m => a -> m a
return (TrillStep -> XParse TrillStep) -> TrillStep -> XParse TrillStep
forall a b. (a -> b) -> a -> b
$ TrillStep
TrillStepHalf
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"unison" = TrillStep -> XParse TrillStep
forall (m :: * -> *) a. Monad m => a -> m a
return (TrillStep -> XParse TrillStep) -> TrillStep -> XParse TrillStep
forall a b. (a -> b) -> a -> b
$ TrillStep
TrillStepUnison
        | Bool
otherwise = String -> XParse TrillStep
forall a. String -> XParse a
P.xfail (String -> XParse TrillStep) -> String -> XParse TrillStep
forall a b. (a -> b) -> a -> b
$ String
"TrillStep: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @two-note-turn@ /(simple)/
--
-- The two-note-turn type describes the ending notes of trills and mordents for playback, relative to the current note.
data TwoNoteTurn = 
      TwoNoteTurnWhole -- ^ /whole/
    | TwoNoteTurnHalf -- ^ /half/
    | TwoNoteTurnNone -- ^ /none/
    deriving (TwoNoteTurn -> TwoNoteTurn -> Bool
(TwoNoteTurn -> TwoNoteTurn -> Bool)
-> (TwoNoteTurn -> TwoNoteTurn -> Bool) -> Eq TwoNoteTurn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c/= :: TwoNoteTurn -> TwoNoteTurn -> Bool
== :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c== :: TwoNoteTurn -> TwoNoteTurn -> Bool
Eq,Typeable,(forall x. TwoNoteTurn -> Rep TwoNoteTurn x)
-> (forall x. Rep TwoNoteTurn x -> TwoNoteTurn)
-> Generic TwoNoteTurn
forall x. Rep TwoNoteTurn x -> TwoNoteTurn
forall x. TwoNoteTurn -> Rep TwoNoteTurn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TwoNoteTurn x -> TwoNoteTurn
$cfrom :: forall x. TwoNoteTurn -> Rep TwoNoteTurn x
Generic,Int -> TwoNoteTurn -> ShowS
[TwoNoteTurn] -> ShowS
TwoNoteTurn -> String
(Int -> TwoNoteTurn -> ShowS)
-> (TwoNoteTurn -> String)
-> ([TwoNoteTurn] -> ShowS)
-> Show TwoNoteTurn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwoNoteTurn] -> ShowS
$cshowList :: [TwoNoteTurn] -> ShowS
show :: TwoNoteTurn -> String
$cshow :: TwoNoteTurn -> String
showsPrec :: Int -> TwoNoteTurn -> ShowS
$cshowsPrec :: Int -> TwoNoteTurn -> ShowS
Show,Eq TwoNoteTurn
Eq TwoNoteTurn
-> (TwoNoteTurn -> TwoNoteTurn -> Ordering)
-> (TwoNoteTurn -> TwoNoteTurn -> Bool)
-> (TwoNoteTurn -> TwoNoteTurn -> Bool)
-> (TwoNoteTurn -> TwoNoteTurn -> Bool)
-> (TwoNoteTurn -> TwoNoteTurn -> Bool)
-> (TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn)
-> (TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn)
-> Ord TwoNoteTurn
TwoNoteTurn -> TwoNoteTurn -> Bool
TwoNoteTurn -> TwoNoteTurn -> Ordering
TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn
$cmin :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn
max :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn
$cmax :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn
>= :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c>= :: TwoNoteTurn -> TwoNoteTurn -> Bool
> :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c> :: TwoNoteTurn -> TwoNoteTurn -> Bool
<= :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c<= :: TwoNoteTurn -> TwoNoteTurn -> Bool
< :: TwoNoteTurn -> TwoNoteTurn -> Bool
$c< :: TwoNoteTurn -> TwoNoteTurn -> Bool
compare :: TwoNoteTurn -> TwoNoteTurn -> Ordering
$ccompare :: TwoNoteTurn -> TwoNoteTurn -> Ordering
$cp1Ord :: Eq TwoNoteTurn
Ord,Int -> TwoNoteTurn
TwoNoteTurn -> Int
TwoNoteTurn -> [TwoNoteTurn]
TwoNoteTurn -> TwoNoteTurn
TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
(TwoNoteTurn -> TwoNoteTurn)
-> (TwoNoteTurn -> TwoNoteTurn)
-> (Int -> TwoNoteTurn)
-> (TwoNoteTurn -> Int)
-> (TwoNoteTurn -> [TwoNoteTurn])
-> (TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn])
-> (TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn])
-> (TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn])
-> Enum TwoNoteTurn
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
$cenumFromThenTo :: TwoNoteTurn -> TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
enumFromTo :: TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
$cenumFromTo :: TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
enumFromThen :: TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
$cenumFromThen :: TwoNoteTurn -> TwoNoteTurn -> [TwoNoteTurn]
enumFrom :: TwoNoteTurn -> [TwoNoteTurn]
$cenumFrom :: TwoNoteTurn -> [TwoNoteTurn]
fromEnum :: TwoNoteTurn -> Int
$cfromEnum :: TwoNoteTurn -> Int
toEnum :: Int -> TwoNoteTurn
$ctoEnum :: Int -> TwoNoteTurn
pred :: TwoNoteTurn -> TwoNoteTurn
$cpred :: TwoNoteTurn -> TwoNoteTurn
succ :: TwoNoteTurn -> TwoNoteTurn
$csucc :: TwoNoteTurn -> TwoNoteTurn
Enum,TwoNoteTurn
TwoNoteTurn -> TwoNoteTurn -> Bounded TwoNoteTurn
forall a. a -> a -> Bounded a
maxBound :: TwoNoteTurn
$cmaxBound :: TwoNoteTurn
minBound :: TwoNoteTurn
$cminBound :: TwoNoteTurn
Bounded)
instance EmitXml TwoNoteTurn where
    emitXml :: TwoNoteTurn -> XmlRep
emitXml TwoNoteTurn
TwoNoteTurnWhole = String -> XmlRep
XLit String
"whole"
    emitXml TwoNoteTurn
TwoNoteTurnHalf = String -> XmlRep
XLit String
"half"
    emitXml TwoNoteTurn
TwoNoteTurnNone = String -> XmlRep
XLit String
"none"
parseTwoNoteTurn :: String -> P.XParse TwoNoteTurn
parseTwoNoteTurn :: String -> XParse TwoNoteTurn
parseTwoNoteTurn String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"whole" = TwoNoteTurn -> XParse TwoNoteTurn
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoNoteTurn -> XParse TwoNoteTurn)
-> TwoNoteTurn -> XParse TwoNoteTurn
forall a b. (a -> b) -> a -> b
$ TwoNoteTurn
TwoNoteTurnWhole
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"half" = TwoNoteTurn -> XParse TwoNoteTurn
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoNoteTurn -> XParse TwoNoteTurn)
-> TwoNoteTurn -> XParse TwoNoteTurn
forall a b. (a -> b) -> a -> b
$ TwoNoteTurn
TwoNoteTurnHalf
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = TwoNoteTurn -> XParse TwoNoteTurn
forall (m :: * -> *) a. Monad m => a -> m a
return (TwoNoteTurn -> XParse TwoNoteTurn)
-> TwoNoteTurn -> XParse TwoNoteTurn
forall a b. (a -> b) -> a -> b
$ TwoNoteTurn
TwoNoteTurnNone
        | Bool
otherwise = String -> XParse TwoNoteTurn
forall a. String -> XParse a
P.xfail (String -> XParse TwoNoteTurn) -> String -> XParse TwoNoteTurn
forall a b. (a -> b) -> a -> b
$ String
"TwoNoteTurn: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @xlink:type@ /(simple)/
data Type = 
      TypeSimple -- ^ /simple/
    deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq,Typeable,(forall x. Type -> Rep Type x)
-> (forall x. Rep Type x -> Type) -> Generic Type
forall x. Rep Type x -> Type
forall x. Type -> Rep Type x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Type x -> Type
$cfrom :: forall x. Type -> Rep Type x
Generic,Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show,Eq Type
Eq Type
-> (Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord,Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
(Type -> Type)
-> (Type -> Type)
-> (Int -> Type)
-> (Type -> Int)
-> (Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> Type -> [Type])
-> Enum Type
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum,Type
Type -> Type -> Bounded Type
forall a. a -> a -> Bounded a
maxBound :: Type
$cmaxBound :: Type
minBound :: Type
$cminBound :: Type
Bounded)
instance EmitXml Type where
    emitXml :: Type -> XmlRep
emitXml Type
TypeSimple = String -> XmlRep
XLit String
"simple"
parseType :: String -> P.XParse Type
parseType :: String -> XParse Type
parseType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"simple" = Type -> XParse Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> XParse Type) -> Type -> XParse Type
forall a b. (a -> b) -> a -> b
$ Type
TypeSimple
        | Bool
otherwise = String -> XParse Type
forall a. String -> XParse a
P.xfail (String -> XParse Type) -> String -> XParse Type
forall a b. (a -> b) -> a -> b
$ String
"Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @up-down@ /(simple)/
--
-- The up-down type is used for the direction of arrows and other pointed symbols like vertical accents, indicating which way the tip is pointing.
data UpDown = 
      UpDownUp -- ^ /up/
    | UpDownDown -- ^ /down/
    deriving (UpDown -> UpDown -> Bool
(UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool) -> Eq UpDown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpDown -> UpDown -> Bool
$c/= :: UpDown -> UpDown -> Bool
== :: UpDown -> UpDown -> Bool
$c== :: UpDown -> UpDown -> Bool
Eq,Typeable,(forall x. UpDown -> Rep UpDown x)
-> (forall x. Rep UpDown x -> UpDown) -> Generic UpDown
forall x. Rep UpDown x -> UpDown
forall x. UpDown -> Rep UpDown x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpDown x -> UpDown
$cfrom :: forall x. UpDown -> Rep UpDown x
Generic,Int -> UpDown -> ShowS
[UpDown] -> ShowS
UpDown -> String
(Int -> UpDown -> ShowS)
-> (UpDown -> String) -> ([UpDown] -> ShowS) -> Show UpDown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpDown] -> ShowS
$cshowList :: [UpDown] -> ShowS
show :: UpDown -> String
$cshow :: UpDown -> String
showsPrec :: Int -> UpDown -> ShowS
$cshowsPrec :: Int -> UpDown -> ShowS
Show,Eq UpDown
Eq UpDown
-> (UpDown -> UpDown -> Ordering)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> UpDown)
-> (UpDown -> UpDown -> UpDown)
-> Ord UpDown
UpDown -> UpDown -> Bool
UpDown -> UpDown -> Ordering
UpDown -> UpDown -> UpDown
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpDown -> UpDown -> UpDown
$cmin :: UpDown -> UpDown -> UpDown
max :: UpDown -> UpDown -> UpDown
$cmax :: UpDown -> UpDown -> UpDown
>= :: UpDown -> UpDown -> Bool
$c>= :: UpDown -> UpDown -> Bool
> :: UpDown -> UpDown -> Bool
$c> :: UpDown -> UpDown -> Bool
<= :: UpDown -> UpDown -> Bool
$c<= :: UpDown -> UpDown -> Bool
< :: UpDown -> UpDown -> Bool
$c< :: UpDown -> UpDown -> Bool
compare :: UpDown -> UpDown -> Ordering
$ccompare :: UpDown -> UpDown -> Ordering
$cp1Ord :: Eq UpDown
Ord,Int -> UpDown
UpDown -> Int
UpDown -> [UpDown]
UpDown -> UpDown
UpDown -> UpDown -> [UpDown]
UpDown -> UpDown -> UpDown -> [UpDown]
(UpDown -> UpDown)
-> (UpDown -> UpDown)
-> (Int -> UpDown)
-> (UpDown -> Int)
-> (UpDown -> [UpDown])
-> (UpDown -> UpDown -> [UpDown])
-> (UpDown -> UpDown -> [UpDown])
-> (UpDown -> UpDown -> UpDown -> [UpDown])
-> Enum UpDown
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UpDown -> UpDown -> UpDown -> [UpDown]
$cenumFromThenTo :: UpDown -> UpDown -> UpDown -> [UpDown]
enumFromTo :: UpDown -> UpDown -> [UpDown]
$cenumFromTo :: UpDown -> UpDown -> [UpDown]
enumFromThen :: UpDown -> UpDown -> [UpDown]
$cenumFromThen :: UpDown -> UpDown -> [UpDown]
enumFrom :: UpDown -> [UpDown]
$cenumFrom :: UpDown -> [UpDown]
fromEnum :: UpDown -> Int
$cfromEnum :: UpDown -> Int
toEnum :: Int -> UpDown
$ctoEnum :: Int -> UpDown
pred :: UpDown -> UpDown
$cpred :: UpDown -> UpDown
succ :: UpDown -> UpDown
$csucc :: UpDown -> UpDown
Enum,UpDown
UpDown -> UpDown -> Bounded UpDown
forall a. a -> a -> Bounded a
maxBound :: UpDown
$cmaxBound :: UpDown
minBound :: UpDown
$cminBound :: UpDown
Bounded)
instance EmitXml UpDown where
    emitXml :: UpDown -> XmlRep
emitXml UpDown
UpDownUp = String -> XmlRep
XLit String
"up"
    emitXml UpDown
UpDownDown = String -> XmlRep
XLit String
"down"
parseUpDown :: String -> P.XParse UpDown
parseUpDown :: String -> XParse UpDown
parseUpDown String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = UpDown -> XParse UpDown
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDown -> XParse UpDown) -> UpDown -> XParse UpDown
forall a b. (a -> b) -> a -> b
$ UpDown
UpDownUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = UpDown -> XParse UpDown
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDown -> XParse UpDown) -> UpDown -> XParse UpDown
forall a b. (a -> b) -> a -> b
$ UpDown
UpDownDown
        | Bool
otherwise = String -> XParse UpDown
forall a. String -> XParse a
P.xfail (String -> XParse UpDown) -> String -> XParse UpDown
forall a b. (a -> b) -> a -> b
$ String
"UpDown: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @up-down-stop-continue@ /(simple)/
--
-- The up-down-stop-continue type is used for octave-shift elements, indicating the direction of the shift from their true pitched values because of printing difficulty.
data UpDownStopContinue = 
      UpDownStopContinueUp -- ^ /up/
    | UpDownStopContinueDown -- ^ /down/
    | UpDownStopContinueStop -- ^ /stop/
    | UpDownStopContinueContinue -- ^ /continue/
    deriving (UpDownStopContinue -> UpDownStopContinue -> Bool
(UpDownStopContinue -> UpDownStopContinue -> Bool)
-> (UpDownStopContinue -> UpDownStopContinue -> Bool)
-> Eq UpDownStopContinue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c/= :: UpDownStopContinue -> UpDownStopContinue -> Bool
== :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c== :: UpDownStopContinue -> UpDownStopContinue -> Bool
Eq,Typeable,(forall x. UpDownStopContinue -> Rep UpDownStopContinue x)
-> (forall x. Rep UpDownStopContinue x -> UpDownStopContinue)
-> Generic UpDownStopContinue
forall x. Rep UpDownStopContinue x -> UpDownStopContinue
forall x. UpDownStopContinue -> Rep UpDownStopContinue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpDownStopContinue x -> UpDownStopContinue
$cfrom :: forall x. UpDownStopContinue -> Rep UpDownStopContinue x
Generic,Int -> UpDownStopContinue -> ShowS
[UpDownStopContinue] -> ShowS
UpDownStopContinue -> String
(Int -> UpDownStopContinue -> ShowS)
-> (UpDownStopContinue -> String)
-> ([UpDownStopContinue] -> ShowS)
-> Show UpDownStopContinue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpDownStopContinue] -> ShowS
$cshowList :: [UpDownStopContinue] -> ShowS
show :: UpDownStopContinue -> String
$cshow :: UpDownStopContinue -> String
showsPrec :: Int -> UpDownStopContinue -> ShowS
$cshowsPrec :: Int -> UpDownStopContinue -> ShowS
Show,Eq UpDownStopContinue
Eq UpDownStopContinue
-> (UpDownStopContinue -> UpDownStopContinue -> Ordering)
-> (UpDownStopContinue -> UpDownStopContinue -> Bool)
-> (UpDownStopContinue -> UpDownStopContinue -> Bool)
-> (UpDownStopContinue -> UpDownStopContinue -> Bool)
-> (UpDownStopContinue -> UpDownStopContinue -> Bool)
-> (UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue)
-> (UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue)
-> Ord UpDownStopContinue
UpDownStopContinue -> UpDownStopContinue -> Bool
UpDownStopContinue -> UpDownStopContinue -> Ordering
UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue
$cmin :: UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue
max :: UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue
$cmax :: UpDownStopContinue -> UpDownStopContinue -> UpDownStopContinue
>= :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c>= :: UpDownStopContinue -> UpDownStopContinue -> Bool
> :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c> :: UpDownStopContinue -> UpDownStopContinue -> Bool
<= :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c<= :: UpDownStopContinue -> UpDownStopContinue -> Bool
< :: UpDownStopContinue -> UpDownStopContinue -> Bool
$c< :: UpDownStopContinue -> UpDownStopContinue -> Bool
compare :: UpDownStopContinue -> UpDownStopContinue -> Ordering
$ccompare :: UpDownStopContinue -> UpDownStopContinue -> Ordering
$cp1Ord :: Eq UpDownStopContinue
Ord,Int -> UpDownStopContinue
UpDownStopContinue -> Int
UpDownStopContinue -> [UpDownStopContinue]
UpDownStopContinue -> UpDownStopContinue
UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
UpDownStopContinue
-> UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
(UpDownStopContinue -> UpDownStopContinue)
-> (UpDownStopContinue -> UpDownStopContinue)
-> (Int -> UpDownStopContinue)
-> (UpDownStopContinue -> Int)
-> (UpDownStopContinue -> [UpDownStopContinue])
-> (UpDownStopContinue
    -> UpDownStopContinue -> [UpDownStopContinue])
-> (UpDownStopContinue
    -> UpDownStopContinue -> [UpDownStopContinue])
-> (UpDownStopContinue
    -> UpDownStopContinue
    -> UpDownStopContinue
    -> [UpDownStopContinue])
-> Enum UpDownStopContinue
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UpDownStopContinue
-> UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
$cenumFromThenTo :: UpDownStopContinue
-> UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
enumFromTo :: UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
$cenumFromTo :: UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
enumFromThen :: UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
$cenumFromThen :: UpDownStopContinue -> UpDownStopContinue -> [UpDownStopContinue]
enumFrom :: UpDownStopContinue -> [UpDownStopContinue]
$cenumFrom :: UpDownStopContinue -> [UpDownStopContinue]
fromEnum :: UpDownStopContinue -> Int
$cfromEnum :: UpDownStopContinue -> Int
toEnum :: Int -> UpDownStopContinue
$ctoEnum :: Int -> UpDownStopContinue
pred :: UpDownStopContinue -> UpDownStopContinue
$cpred :: UpDownStopContinue -> UpDownStopContinue
succ :: UpDownStopContinue -> UpDownStopContinue
$csucc :: UpDownStopContinue -> UpDownStopContinue
Enum,UpDownStopContinue
UpDownStopContinue
-> UpDownStopContinue -> Bounded UpDownStopContinue
forall a. a -> a -> Bounded a
maxBound :: UpDownStopContinue
$cmaxBound :: UpDownStopContinue
minBound :: UpDownStopContinue
$cminBound :: UpDownStopContinue
Bounded)
instance EmitXml UpDownStopContinue where
    emitXml :: UpDownStopContinue -> XmlRep
emitXml UpDownStopContinue
UpDownStopContinueUp = String -> XmlRep
XLit String
"up"
    emitXml UpDownStopContinue
UpDownStopContinueDown = String -> XmlRep
XLit String
"down"
    emitXml UpDownStopContinue
UpDownStopContinueStop = String -> XmlRep
XLit String
"stop"
    emitXml UpDownStopContinue
UpDownStopContinueContinue = String -> XmlRep
XLit String
"continue"
parseUpDownStopContinue :: String -> P.XParse UpDownStopContinue
parseUpDownStopContinue :: String -> XParse UpDownStopContinue
parseUpDownStopContinue String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = UpDownStopContinue -> XParse UpDownStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDownStopContinue -> XParse UpDownStopContinue)
-> UpDownStopContinue -> XParse UpDownStopContinue
forall a b. (a -> b) -> a -> b
$ UpDownStopContinue
UpDownStopContinueUp
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = UpDownStopContinue -> XParse UpDownStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDownStopContinue -> XParse UpDownStopContinue)
-> UpDownStopContinue -> XParse UpDownStopContinue
forall a b. (a -> b) -> a -> b
$ UpDownStopContinue
UpDownStopContinueDown
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = UpDownStopContinue -> XParse UpDownStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDownStopContinue -> XParse UpDownStopContinue)
-> UpDownStopContinue -> XParse UpDownStopContinue
forall a b. (a -> b) -> a -> b
$ UpDownStopContinue
UpDownStopContinueStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = UpDownStopContinue -> XParse UpDownStopContinue
forall (m :: * -> *) a. Monad m => a -> m a
return (UpDownStopContinue -> XParse UpDownStopContinue)
-> UpDownStopContinue -> XParse UpDownStopContinue
forall a b. (a -> b) -> a -> b
$ UpDownStopContinue
UpDownStopContinueContinue
        | Bool
otherwise = String -> XParse UpDownStopContinue
forall a. String -> XParse a
P.xfail (String -> XParse UpDownStopContinue)
-> String -> XParse UpDownStopContinue
forall a b. (a -> b) -> a -> b
$ String
"UpDownStopContinue: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @upright-inverted@ /(simple)/
--
-- The upright-inverted type describes the appearance of a fermata element. The value is upright if not specified.
data UprightInverted = 
      UprightInvertedUpright -- ^ /upright/
    | UprightInvertedInverted -- ^ /inverted/
    deriving (UprightInverted -> UprightInverted -> Bool
(UprightInverted -> UprightInverted -> Bool)
-> (UprightInverted -> UprightInverted -> Bool)
-> Eq UprightInverted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UprightInverted -> UprightInverted -> Bool
$c/= :: UprightInverted -> UprightInverted -> Bool
== :: UprightInverted -> UprightInverted -> Bool
$c== :: UprightInverted -> UprightInverted -> Bool
Eq,Typeable,(forall x. UprightInverted -> Rep UprightInverted x)
-> (forall x. Rep UprightInverted x -> UprightInverted)
-> Generic UprightInverted
forall x. Rep UprightInverted x -> UprightInverted
forall x. UprightInverted -> Rep UprightInverted x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UprightInverted x -> UprightInverted
$cfrom :: forall x. UprightInverted -> Rep UprightInverted x
Generic,Int -> UprightInverted -> ShowS
[UprightInverted] -> ShowS
UprightInverted -> String
(Int -> UprightInverted -> ShowS)
-> (UprightInverted -> String)
-> ([UprightInverted] -> ShowS)
-> Show UprightInverted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UprightInverted] -> ShowS
$cshowList :: [UprightInverted] -> ShowS
show :: UprightInverted -> String
$cshow :: UprightInverted -> String
showsPrec :: Int -> UprightInverted -> ShowS
$cshowsPrec :: Int -> UprightInverted -> ShowS
Show,Eq UprightInverted
Eq UprightInverted
-> (UprightInverted -> UprightInverted -> Ordering)
-> (UprightInverted -> UprightInverted -> Bool)
-> (UprightInverted -> UprightInverted -> Bool)
-> (UprightInverted -> UprightInverted -> Bool)
-> (UprightInverted -> UprightInverted -> Bool)
-> (UprightInverted -> UprightInverted -> UprightInverted)
-> (UprightInverted -> UprightInverted -> UprightInverted)
-> Ord UprightInverted
UprightInverted -> UprightInverted -> Bool
UprightInverted -> UprightInverted -> Ordering
UprightInverted -> UprightInverted -> UprightInverted
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UprightInverted -> UprightInverted -> UprightInverted
$cmin :: UprightInverted -> UprightInverted -> UprightInverted
max :: UprightInverted -> UprightInverted -> UprightInverted
$cmax :: UprightInverted -> UprightInverted -> UprightInverted
>= :: UprightInverted -> UprightInverted -> Bool
$c>= :: UprightInverted -> UprightInverted -> Bool
> :: UprightInverted -> UprightInverted -> Bool
$c> :: UprightInverted -> UprightInverted -> Bool
<= :: UprightInverted -> UprightInverted -> Bool
$c<= :: UprightInverted -> UprightInverted -> Bool
< :: UprightInverted -> UprightInverted -> Bool
$c< :: UprightInverted -> UprightInverted -> Bool
compare :: UprightInverted -> UprightInverted -> Ordering
$ccompare :: UprightInverted -> UprightInverted -> Ordering
$cp1Ord :: Eq UprightInverted
Ord,Int -> UprightInverted
UprightInverted -> Int
UprightInverted -> [UprightInverted]
UprightInverted -> UprightInverted
UprightInverted -> UprightInverted -> [UprightInverted]
UprightInverted
-> UprightInverted -> UprightInverted -> [UprightInverted]
(UprightInverted -> UprightInverted)
-> (UprightInverted -> UprightInverted)
-> (Int -> UprightInverted)
-> (UprightInverted -> Int)
-> (UprightInverted -> [UprightInverted])
-> (UprightInverted -> UprightInverted -> [UprightInverted])
-> (UprightInverted -> UprightInverted -> [UprightInverted])
-> (UprightInverted
    -> UprightInverted -> UprightInverted -> [UprightInverted])
-> Enum UprightInverted
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UprightInverted
-> UprightInverted -> UprightInverted -> [UprightInverted]
$cenumFromThenTo :: UprightInverted
-> UprightInverted -> UprightInverted -> [UprightInverted]
enumFromTo :: UprightInverted -> UprightInverted -> [UprightInverted]
$cenumFromTo :: UprightInverted -> UprightInverted -> [UprightInverted]
enumFromThen :: UprightInverted -> UprightInverted -> [UprightInverted]
$cenumFromThen :: UprightInverted -> UprightInverted -> [UprightInverted]
enumFrom :: UprightInverted -> [UprightInverted]
$cenumFrom :: UprightInverted -> [UprightInverted]
fromEnum :: UprightInverted -> Int
$cfromEnum :: UprightInverted -> Int
toEnum :: Int -> UprightInverted
$ctoEnum :: Int -> UprightInverted
pred :: UprightInverted -> UprightInverted
$cpred :: UprightInverted -> UprightInverted
succ :: UprightInverted -> UprightInverted
$csucc :: UprightInverted -> UprightInverted
Enum,UprightInverted
UprightInverted -> UprightInverted -> Bounded UprightInverted
forall a. a -> a -> Bounded a
maxBound :: UprightInverted
$cmaxBound :: UprightInverted
minBound :: UprightInverted
$cminBound :: UprightInverted
Bounded)
instance EmitXml UprightInverted where
    emitXml :: UprightInverted -> XmlRep
emitXml UprightInverted
UprightInvertedUpright = String -> XmlRep
XLit String
"upright"
    emitXml UprightInverted
UprightInvertedInverted = String -> XmlRep
XLit String
"inverted"
parseUprightInverted :: String -> P.XParse UprightInverted
parseUprightInverted :: String -> XParse UprightInverted
parseUprightInverted String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"upright" = UprightInverted -> XParse UprightInverted
forall (m :: * -> *) a. Monad m => a -> m a
return (UprightInverted -> XParse UprightInverted)
-> UprightInverted -> XParse UprightInverted
forall a b. (a -> b) -> a -> b
$ UprightInverted
UprightInvertedUpright
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"inverted" = UprightInverted -> XParse UprightInverted
forall (m :: * -> *) a. Monad m => a -> m a
return (UprightInverted -> XParse UprightInverted)
-> UprightInverted -> XParse UprightInverted
forall a b. (a -> b) -> a -> b
$ UprightInverted
UprightInvertedInverted
        | Bool
otherwise = String -> XParse UprightInverted
forall a. String -> XParse a
P.xfail (String -> XParse UprightInverted)
-> String -> XParse UprightInverted
forall a b. (a -> b) -> a -> b
$ String
"UprightInverted: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @valign@ /(simple)/
--
-- The valign type is used to indicate vertical alignment to the top, middle, bottom, or baseline of the text. Defaults are implementation-dependent.
data Valign = 
      ValignTop -- ^ /top/
    | ValignMiddle -- ^ /middle/
    | ValignBottom -- ^ /bottom/
    | ValignBaseline -- ^ /baseline/
    deriving (Valign -> Valign -> Bool
(Valign -> Valign -> Bool)
-> (Valign -> Valign -> Bool) -> Eq Valign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Valign -> Valign -> Bool
$c/= :: Valign -> Valign -> Bool
== :: Valign -> Valign -> Bool
$c== :: Valign -> Valign -> Bool
Eq,Typeable,(forall x. Valign -> Rep Valign x)
-> (forall x. Rep Valign x -> Valign) -> Generic Valign
forall x. Rep Valign x -> Valign
forall x. Valign -> Rep Valign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Valign x -> Valign
$cfrom :: forall x. Valign -> Rep Valign x
Generic,Int -> Valign -> ShowS
[Valign] -> ShowS
Valign -> String
(Int -> Valign -> ShowS)
-> (Valign -> String) -> ([Valign] -> ShowS) -> Show Valign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Valign] -> ShowS
$cshowList :: [Valign] -> ShowS
show :: Valign -> String
$cshow :: Valign -> String
showsPrec :: Int -> Valign -> ShowS
$cshowsPrec :: Int -> Valign -> ShowS
Show,Eq Valign
Eq Valign
-> (Valign -> Valign -> Ordering)
-> (Valign -> Valign -> Bool)
-> (Valign -> Valign -> Bool)
-> (Valign -> Valign -> Bool)
-> (Valign -> Valign -> Bool)
-> (Valign -> Valign -> Valign)
-> (Valign -> Valign -> Valign)
-> Ord Valign
Valign -> Valign -> Bool
Valign -> Valign -> Ordering
Valign -> Valign -> Valign
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Valign -> Valign -> Valign
$cmin :: Valign -> Valign -> Valign
max :: Valign -> Valign -> Valign
$cmax :: Valign -> Valign -> Valign
>= :: Valign -> Valign -> Bool
$c>= :: Valign -> Valign -> Bool
> :: Valign -> Valign -> Bool
$c> :: Valign -> Valign -> Bool
<= :: Valign -> Valign -> Bool
$c<= :: Valign -> Valign -> Bool
< :: Valign -> Valign -> Bool
$c< :: Valign -> Valign -> Bool
compare :: Valign -> Valign -> Ordering
$ccompare :: Valign -> Valign -> Ordering
$cp1Ord :: Eq Valign
Ord,Int -> Valign
Valign -> Int
Valign -> [Valign]
Valign -> Valign
Valign -> Valign -> [Valign]
Valign -> Valign -> Valign -> [Valign]
(Valign -> Valign)
-> (Valign -> Valign)
-> (Int -> Valign)
-> (Valign -> Int)
-> (Valign -> [Valign])
-> (Valign -> Valign -> [Valign])
-> (Valign -> Valign -> [Valign])
-> (Valign -> Valign -> Valign -> [Valign])
-> Enum Valign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Valign -> Valign -> Valign -> [Valign]
$cenumFromThenTo :: Valign -> Valign -> Valign -> [Valign]
enumFromTo :: Valign -> Valign -> [Valign]
$cenumFromTo :: Valign -> Valign -> [Valign]
enumFromThen :: Valign -> Valign -> [Valign]
$cenumFromThen :: Valign -> Valign -> [Valign]
enumFrom :: Valign -> [Valign]
$cenumFrom :: Valign -> [Valign]
fromEnum :: Valign -> Int
$cfromEnum :: Valign -> Int
toEnum :: Int -> Valign
$ctoEnum :: Int -> Valign
pred :: Valign -> Valign
$cpred :: Valign -> Valign
succ :: Valign -> Valign
$csucc :: Valign -> Valign
Enum,Valign
Valign -> Valign -> Bounded Valign
forall a. a -> a -> Bounded a
maxBound :: Valign
$cmaxBound :: Valign
minBound :: Valign
$cminBound :: Valign
Bounded)
instance EmitXml Valign where
    emitXml :: Valign -> XmlRep
emitXml Valign
ValignTop = String -> XmlRep
XLit String
"top"
    emitXml Valign
ValignMiddle = String -> XmlRep
XLit String
"middle"
    emitXml Valign
ValignBottom = String -> XmlRep
XLit String
"bottom"
    emitXml Valign
ValignBaseline = String -> XmlRep
XLit String
"baseline"
parseValign :: String -> P.XParse Valign
parseValign :: String -> XParse Valign
parseValign String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"top" = Valign -> XParse Valign
forall (m :: * -> *) a. Monad m => a -> m a
return (Valign -> XParse Valign) -> Valign -> XParse Valign
forall a b. (a -> b) -> a -> b
$ Valign
ValignTop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"middle" = Valign -> XParse Valign
forall (m :: * -> *) a. Monad m => a -> m a
return (Valign -> XParse Valign) -> Valign -> XParse Valign
forall a b. (a -> b) -> a -> b
$ Valign
ValignMiddle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bottom" = Valign -> XParse Valign
forall (m :: * -> *) a. Monad m => a -> m a
return (Valign -> XParse Valign) -> Valign -> XParse Valign
forall a b. (a -> b) -> a -> b
$ Valign
ValignBottom
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"baseline" = Valign -> XParse Valign
forall (m :: * -> *) a. Monad m => a -> m a
return (Valign -> XParse Valign) -> Valign -> XParse Valign
forall a b. (a -> b) -> a -> b
$ Valign
ValignBaseline
        | Bool
otherwise = String -> XParse Valign
forall a. String -> XParse a
P.xfail (String -> XParse Valign) -> String -> XParse Valign
forall a b. (a -> b) -> a -> b
$ String
"Valign: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @valign-image@ /(simple)/
--
-- The valign-image type is used to indicate vertical alignment for images and graphics, so it does not include a baseline value. Defaults are implementation-dependent.
data ValignImage = 
      ValignImageTop -- ^ /top/
    | ValignImageMiddle -- ^ /middle/
    | ValignImageBottom -- ^ /bottom/
    deriving (ValignImage -> ValignImage -> Bool
(ValignImage -> ValignImage -> Bool)
-> (ValignImage -> ValignImage -> Bool) -> Eq ValignImage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValignImage -> ValignImage -> Bool
$c/= :: ValignImage -> ValignImage -> Bool
== :: ValignImage -> ValignImage -> Bool
$c== :: ValignImage -> ValignImage -> Bool
Eq,Typeable,(forall x. ValignImage -> Rep ValignImage x)
-> (forall x. Rep ValignImage x -> ValignImage)
-> Generic ValignImage
forall x. Rep ValignImage x -> ValignImage
forall x. ValignImage -> Rep ValignImage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ValignImage x -> ValignImage
$cfrom :: forall x. ValignImage -> Rep ValignImage x
Generic,Int -> ValignImage -> ShowS
[ValignImage] -> ShowS
ValignImage -> String
(Int -> ValignImage -> ShowS)
-> (ValignImage -> String)
-> ([ValignImage] -> ShowS)
-> Show ValignImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValignImage] -> ShowS
$cshowList :: [ValignImage] -> ShowS
show :: ValignImage -> String
$cshow :: ValignImage -> String
showsPrec :: Int -> ValignImage -> ShowS
$cshowsPrec :: Int -> ValignImage -> ShowS
Show,Eq ValignImage
Eq ValignImage
-> (ValignImage -> ValignImage -> Ordering)
-> (ValignImage -> ValignImage -> Bool)
-> (ValignImage -> ValignImage -> Bool)
-> (ValignImage -> ValignImage -> Bool)
-> (ValignImage -> ValignImage -> Bool)
-> (ValignImage -> ValignImage -> ValignImage)
-> (ValignImage -> ValignImage -> ValignImage)
-> Ord ValignImage
ValignImage -> ValignImage -> Bool
ValignImage -> ValignImage -> Ordering
ValignImage -> ValignImage -> ValignImage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ValignImage -> ValignImage -> ValignImage
$cmin :: ValignImage -> ValignImage -> ValignImage
max :: ValignImage -> ValignImage -> ValignImage
$cmax :: ValignImage -> ValignImage -> ValignImage
>= :: ValignImage -> ValignImage -> Bool
$c>= :: ValignImage -> ValignImage -> Bool
> :: ValignImage -> ValignImage -> Bool
$c> :: ValignImage -> ValignImage -> Bool
<= :: ValignImage -> ValignImage -> Bool
$c<= :: ValignImage -> ValignImage -> Bool
< :: ValignImage -> ValignImage -> Bool
$c< :: ValignImage -> ValignImage -> Bool
compare :: ValignImage -> ValignImage -> Ordering
$ccompare :: ValignImage -> ValignImage -> Ordering
$cp1Ord :: Eq ValignImage
Ord,Int -> ValignImage
ValignImage -> Int
ValignImage -> [ValignImage]
ValignImage -> ValignImage
ValignImage -> ValignImage -> [ValignImage]
ValignImage -> ValignImage -> ValignImage -> [ValignImage]
(ValignImage -> ValignImage)
-> (ValignImage -> ValignImage)
-> (Int -> ValignImage)
-> (ValignImage -> Int)
-> (ValignImage -> [ValignImage])
-> (ValignImage -> ValignImage -> [ValignImage])
-> (ValignImage -> ValignImage -> [ValignImage])
-> (ValignImage -> ValignImage -> ValignImage -> [ValignImage])
-> Enum ValignImage
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ValignImage -> ValignImage -> ValignImage -> [ValignImage]
$cenumFromThenTo :: ValignImage -> ValignImage -> ValignImage -> [ValignImage]
enumFromTo :: ValignImage -> ValignImage -> [ValignImage]
$cenumFromTo :: ValignImage -> ValignImage -> [ValignImage]
enumFromThen :: ValignImage -> ValignImage -> [ValignImage]
$cenumFromThen :: ValignImage -> ValignImage -> [ValignImage]
enumFrom :: ValignImage -> [ValignImage]
$cenumFrom :: ValignImage -> [ValignImage]
fromEnum :: ValignImage -> Int
$cfromEnum :: ValignImage -> Int
toEnum :: Int -> ValignImage
$ctoEnum :: Int -> ValignImage
pred :: ValignImage -> ValignImage
$cpred :: ValignImage -> ValignImage
succ :: ValignImage -> ValignImage
$csucc :: ValignImage -> ValignImage
Enum,ValignImage
ValignImage -> ValignImage -> Bounded ValignImage
forall a. a -> a -> Bounded a
maxBound :: ValignImage
$cmaxBound :: ValignImage
minBound :: ValignImage
$cminBound :: ValignImage
Bounded)
instance EmitXml ValignImage where
    emitXml :: ValignImage -> XmlRep
emitXml ValignImage
ValignImageTop = String -> XmlRep
XLit String
"top"
    emitXml ValignImage
ValignImageMiddle = String -> XmlRep
XLit String
"middle"
    emitXml ValignImage
ValignImageBottom = String -> XmlRep
XLit String
"bottom"
parseValignImage :: String -> P.XParse ValignImage
parseValignImage :: String -> XParse ValignImage
parseValignImage String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"top" = ValignImage -> XParse ValignImage
forall (m :: * -> *) a. Monad m => a -> m a
return (ValignImage -> XParse ValignImage)
-> ValignImage -> XParse ValignImage
forall a b. (a -> b) -> a -> b
$ ValignImage
ValignImageTop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"middle" = ValignImage -> XParse ValignImage
forall (m :: * -> *) a. Monad m => a -> m a
return (ValignImage -> XParse ValignImage)
-> ValignImage -> XParse ValignImage
forall a b. (a -> b) -> a -> b
$ ValignImage
ValignImageMiddle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bottom" = ValignImage -> XParse ValignImage
forall (m :: * -> *) a. Monad m => a -> m a
return (ValignImage -> XParse ValignImage)
-> ValignImage -> XParse ValignImage
forall a b. (a -> b) -> a -> b
$ ValignImage
ValignImageBottom
        | Bool
otherwise = String -> XParse ValignImage
forall a. String -> XParse a
P.xfail (String -> XParse ValignImage) -> String -> XParse ValignImage
forall a b. (a -> b) -> a -> b
$ String
"ValignImage: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @wedge-type@ /(simple)/
--
-- The wedge type is crescendo for the start of a wedge that is closed at the left side, diminuendo for the start of a wedge that is closed on the right side, and stop for the end of a wedge. The continue type is used for formatting wedges over a system break, or for other situations where a single wedge is divided into multiple segments.
data WedgeType = 
      WedgeTypeCrescendo -- ^ /crescendo/
    | WedgeTypeDiminuendo -- ^ /diminuendo/
    | WedgeTypeStop -- ^ /stop/
    | WedgeTypeContinue -- ^ /continue/
    deriving (WedgeType -> WedgeType -> Bool
(WedgeType -> WedgeType -> Bool)
-> (WedgeType -> WedgeType -> Bool) -> Eq WedgeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WedgeType -> WedgeType -> Bool
$c/= :: WedgeType -> WedgeType -> Bool
== :: WedgeType -> WedgeType -> Bool
$c== :: WedgeType -> WedgeType -> Bool
Eq,Typeable,(forall x. WedgeType -> Rep WedgeType x)
-> (forall x. Rep WedgeType x -> WedgeType) -> Generic WedgeType
forall x. Rep WedgeType x -> WedgeType
forall x. WedgeType -> Rep WedgeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WedgeType x -> WedgeType
$cfrom :: forall x. WedgeType -> Rep WedgeType x
Generic,Int -> WedgeType -> ShowS
[WedgeType] -> ShowS
WedgeType -> String
(Int -> WedgeType -> ShowS)
-> (WedgeType -> String)
-> ([WedgeType] -> ShowS)
-> Show WedgeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WedgeType] -> ShowS
$cshowList :: [WedgeType] -> ShowS
show :: WedgeType -> String
$cshow :: WedgeType -> String
showsPrec :: Int -> WedgeType -> ShowS
$cshowsPrec :: Int -> WedgeType -> ShowS
Show,Eq WedgeType
Eq WedgeType
-> (WedgeType -> WedgeType -> Ordering)
-> (WedgeType -> WedgeType -> Bool)
-> (WedgeType -> WedgeType -> Bool)
-> (WedgeType -> WedgeType -> Bool)
-> (WedgeType -> WedgeType -> Bool)
-> (WedgeType -> WedgeType -> WedgeType)
-> (WedgeType -> WedgeType -> WedgeType)
-> Ord WedgeType
WedgeType -> WedgeType -> Bool
WedgeType -> WedgeType -> Ordering
WedgeType -> WedgeType -> WedgeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WedgeType -> WedgeType -> WedgeType
$cmin :: WedgeType -> WedgeType -> WedgeType
max :: WedgeType -> WedgeType -> WedgeType
$cmax :: WedgeType -> WedgeType -> WedgeType
>= :: WedgeType -> WedgeType -> Bool
$c>= :: WedgeType -> WedgeType -> Bool
> :: WedgeType -> WedgeType -> Bool
$c> :: WedgeType -> WedgeType -> Bool
<= :: WedgeType -> WedgeType -> Bool
$c<= :: WedgeType -> WedgeType -> Bool
< :: WedgeType -> WedgeType -> Bool
$c< :: WedgeType -> WedgeType -> Bool
compare :: WedgeType -> WedgeType -> Ordering
$ccompare :: WedgeType -> WedgeType -> Ordering
$cp1Ord :: Eq WedgeType
Ord,Int -> WedgeType
WedgeType -> Int
WedgeType -> [WedgeType]
WedgeType -> WedgeType
WedgeType -> WedgeType -> [WedgeType]
WedgeType -> WedgeType -> WedgeType -> [WedgeType]
(WedgeType -> WedgeType)
-> (WedgeType -> WedgeType)
-> (Int -> WedgeType)
-> (WedgeType -> Int)
-> (WedgeType -> [WedgeType])
-> (WedgeType -> WedgeType -> [WedgeType])
-> (WedgeType -> WedgeType -> [WedgeType])
-> (WedgeType -> WedgeType -> WedgeType -> [WedgeType])
-> Enum WedgeType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: WedgeType -> WedgeType -> WedgeType -> [WedgeType]
$cenumFromThenTo :: WedgeType -> WedgeType -> WedgeType -> [WedgeType]
enumFromTo :: WedgeType -> WedgeType -> [WedgeType]
$cenumFromTo :: WedgeType -> WedgeType -> [WedgeType]
enumFromThen :: WedgeType -> WedgeType -> [WedgeType]
$cenumFromThen :: WedgeType -> WedgeType -> [WedgeType]
enumFrom :: WedgeType -> [WedgeType]
$cenumFrom :: WedgeType -> [WedgeType]
fromEnum :: WedgeType -> Int
$cfromEnum :: WedgeType -> Int
toEnum :: Int -> WedgeType
$ctoEnum :: Int -> WedgeType
pred :: WedgeType -> WedgeType
$cpred :: WedgeType -> WedgeType
succ :: WedgeType -> WedgeType
$csucc :: WedgeType -> WedgeType
Enum,WedgeType
WedgeType -> WedgeType -> Bounded WedgeType
forall a. a -> a -> Bounded a
maxBound :: WedgeType
$cmaxBound :: WedgeType
minBound :: WedgeType
$cminBound :: WedgeType
Bounded)
instance EmitXml WedgeType where
    emitXml :: WedgeType -> XmlRep
emitXml WedgeType
WedgeTypeCrescendo = String -> XmlRep
XLit String
"crescendo"
    emitXml WedgeType
WedgeTypeDiminuendo = String -> XmlRep
XLit String
"diminuendo"
    emitXml WedgeType
WedgeTypeStop = String -> XmlRep
XLit String
"stop"
    emitXml WedgeType
WedgeTypeContinue = String -> XmlRep
XLit String
"continue"
parseWedgeType :: String -> P.XParse WedgeType
parseWedgeType :: String -> XParse WedgeType
parseWedgeType String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"crescendo" = WedgeType -> XParse WedgeType
forall (m :: * -> *) a. Monad m => a -> m a
return (WedgeType -> XParse WedgeType) -> WedgeType -> XParse WedgeType
forall a b. (a -> b) -> a -> b
$ WedgeType
WedgeTypeCrescendo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"diminuendo" = WedgeType -> XParse WedgeType
forall (m :: * -> *) a. Monad m => a -> m a
return (WedgeType -> XParse WedgeType) -> WedgeType -> XParse WedgeType
forall a b. (a -> b) -> a -> b
$ WedgeType
WedgeTypeDiminuendo
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"stop" = WedgeType -> XParse WedgeType
forall (m :: * -> *) a. Monad m => a -> m a
return (WedgeType -> XParse WedgeType) -> WedgeType -> XParse WedgeType
forall a b. (a -> b) -> a -> b
$ WedgeType
WedgeTypeStop
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"continue" = WedgeType -> XParse WedgeType
forall (m :: * -> *) a. Monad m => a -> m a
return (WedgeType -> XParse WedgeType) -> WedgeType -> XParse WedgeType
forall a b. (a -> b) -> a -> b
$ WedgeType
WedgeTypeContinue
        | Bool
otherwise = String -> XParse WedgeType
forall a. String -> XParse a
P.xfail (String -> XParse WedgeType) -> String -> XParse WedgeType
forall a b. (a -> b) -> a -> b
$ String
"WedgeType: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @winged@ /(simple)/
--
-- The winged attribute indicates whether the repeat has winged extensions that appear above and below the barline. The straight and curved values represent single wings, while the double-straight and double-curved values represent double wings. The none value indicates no wings and is the default.
data Winged = 
      WingedNone -- ^ /none/
    | WingedStraight -- ^ /straight/
    | WingedCurved -- ^ /curved/
    | WingedDoubleStraight -- ^ /double-straight/
    | WingedDoubleCurved -- ^ /double-curved/
    deriving (Winged -> Winged -> Bool
(Winged -> Winged -> Bool)
-> (Winged -> Winged -> Bool) -> Eq Winged
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Winged -> Winged -> Bool
$c/= :: Winged -> Winged -> Bool
== :: Winged -> Winged -> Bool
$c== :: Winged -> Winged -> Bool
Eq,Typeable,(forall x. Winged -> Rep Winged x)
-> (forall x. Rep Winged x -> Winged) -> Generic Winged
forall x. Rep Winged x -> Winged
forall x. Winged -> Rep Winged x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Winged x -> Winged
$cfrom :: forall x. Winged -> Rep Winged x
Generic,Int -> Winged -> ShowS
[Winged] -> ShowS
Winged -> String
(Int -> Winged -> ShowS)
-> (Winged -> String) -> ([Winged] -> ShowS) -> Show Winged
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Winged] -> ShowS
$cshowList :: [Winged] -> ShowS
show :: Winged -> String
$cshow :: Winged -> String
showsPrec :: Int -> Winged -> ShowS
$cshowsPrec :: Int -> Winged -> ShowS
Show,Eq Winged
Eq Winged
-> (Winged -> Winged -> Ordering)
-> (Winged -> Winged -> Bool)
-> (Winged -> Winged -> Bool)
-> (Winged -> Winged -> Bool)
-> (Winged -> Winged -> Bool)
-> (Winged -> Winged -> Winged)
-> (Winged -> Winged -> Winged)
-> Ord Winged
Winged -> Winged -> Bool
Winged -> Winged -> Ordering
Winged -> Winged -> Winged
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Winged -> Winged -> Winged
$cmin :: Winged -> Winged -> Winged
max :: Winged -> Winged -> Winged
$cmax :: Winged -> Winged -> Winged
>= :: Winged -> Winged -> Bool
$c>= :: Winged -> Winged -> Bool
> :: Winged -> Winged -> Bool
$c> :: Winged -> Winged -> Bool
<= :: Winged -> Winged -> Bool
$c<= :: Winged -> Winged -> Bool
< :: Winged -> Winged -> Bool
$c< :: Winged -> Winged -> Bool
compare :: Winged -> Winged -> Ordering
$ccompare :: Winged -> Winged -> Ordering
$cp1Ord :: Eq Winged
Ord,Int -> Winged
Winged -> Int
Winged -> [Winged]
Winged -> Winged
Winged -> Winged -> [Winged]
Winged -> Winged -> Winged -> [Winged]
(Winged -> Winged)
-> (Winged -> Winged)
-> (Int -> Winged)
-> (Winged -> Int)
-> (Winged -> [Winged])
-> (Winged -> Winged -> [Winged])
-> (Winged -> Winged -> [Winged])
-> (Winged -> Winged -> Winged -> [Winged])
-> Enum Winged
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Winged -> Winged -> Winged -> [Winged]
$cenumFromThenTo :: Winged -> Winged -> Winged -> [Winged]
enumFromTo :: Winged -> Winged -> [Winged]
$cenumFromTo :: Winged -> Winged -> [Winged]
enumFromThen :: Winged -> Winged -> [Winged]
$cenumFromThen :: Winged -> Winged -> [Winged]
enumFrom :: Winged -> [Winged]
$cenumFrom :: Winged -> [Winged]
fromEnum :: Winged -> Int
$cfromEnum :: Winged -> Int
toEnum :: Int -> Winged
$ctoEnum :: Int -> Winged
pred :: Winged -> Winged
$cpred :: Winged -> Winged
succ :: Winged -> Winged
$csucc :: Winged -> Winged
Enum,Winged
Winged -> Winged -> Bounded Winged
forall a. a -> a -> Bounded a
maxBound :: Winged
$cmaxBound :: Winged
minBound :: Winged
$cminBound :: Winged
Bounded)
instance EmitXml Winged where
    emitXml :: Winged -> XmlRep
emitXml Winged
WingedNone = String -> XmlRep
XLit String
"none"
    emitXml Winged
WingedStraight = String -> XmlRep
XLit String
"straight"
    emitXml Winged
WingedCurved = String -> XmlRep
XLit String
"curved"
    emitXml Winged
WingedDoubleStraight = String -> XmlRep
XLit String
"double-straight"
    emitXml Winged
WingedDoubleCurved = String -> XmlRep
XLit String
"double-curved"
parseWinged :: String -> P.XParse Winged
parseWinged :: String -> XParse Winged
parseWinged String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"none" = Winged -> XParse Winged
forall (m :: * -> *) a. Monad m => a -> m a
return (Winged -> XParse Winged) -> Winged -> XParse Winged
forall a b. (a -> b) -> a -> b
$ Winged
WingedNone
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"straight" = Winged -> XParse Winged
forall (m :: * -> *) a. Monad m => a -> m a
return (Winged -> XParse Winged) -> Winged -> XParse Winged
forall a b. (a -> b) -> a -> b
$ Winged
WingedStraight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"curved" = Winged -> XParse Winged
forall (m :: * -> *) a. Monad m => a -> m a
return (Winged -> XParse Winged) -> Winged -> XParse Winged
forall a b. (a -> b) -> a -> b
$ Winged
WingedCurved
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-straight" = Winged -> XParse Winged
forall (m :: * -> *) a. Monad m => a -> m a
return (Winged -> XParse Winged) -> Winged -> XParse Winged
forall a b. (a -> b) -> a -> b
$ Winged
WingedDoubleStraight
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"double-curved" = Winged -> XParse Winged
forall (m :: * -> *) a. Monad m => a -> m a
return (Winged -> XParse Winged) -> Winged -> XParse Winged
forall a b. (a -> b) -> a -> b
$ Winged
WingedDoubleCurved
        | Bool
otherwise = String -> XParse Winged
forall a. String -> XParse a
P.xfail (String -> XParse Winged) -> String -> XParse Winged
forall a b. (a -> b) -> a -> b
$ String
"Winged: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @wood@ /(simple)/
--
-- The wood type represents pictograms for wood percussion instruments. The maraca and maracas values distinguish the one- and two-maraca versions of the pictogram.
data Wood = 
      WoodBambooScraper -- ^ /bamboo scraper/
    | WoodBoardClapper -- ^ /board clapper/
    | WoodCabasa -- ^ /cabasa/
    | WoodCastanets -- ^ /castanets/
    | WoodCastanetsWithHandle -- ^ /castanets with handle/
    | WoodClaves -- ^ /claves/
    | WoodFootballRattle -- ^ /football rattle/
    | WoodGuiro -- ^ /guiro/
    | WoodLogDrum -- ^ /log drum/
    | WoodMaraca -- ^ /maraca/
    | WoodMaracas -- ^ /maracas/
    | WoodQuijada -- ^ /quijada/
    | WoodRainstick -- ^ /rainstick/
    | WoodRatchet -- ^ /ratchet/
    | WoodRecoReco -- ^ /reco-reco/
    | WoodSandpaperBlocks -- ^ /sandpaper blocks/
    | WoodSlitDrum -- ^ /slit drum/
    | WoodTempleBlock -- ^ /temple block/
    | WoodVibraslap -- ^ /vibraslap/
    | WoodWhip -- ^ /whip/
    | WoodWoodBlock -- ^ /wood block/
    deriving (Wood -> Wood -> Bool
(Wood -> Wood -> Bool) -> (Wood -> Wood -> Bool) -> Eq Wood
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wood -> Wood -> Bool
$c/= :: Wood -> Wood -> Bool
== :: Wood -> Wood -> Bool
$c== :: Wood -> Wood -> Bool
Eq,Typeable,(forall x. Wood -> Rep Wood x)
-> (forall x. Rep Wood x -> Wood) -> Generic Wood
forall x. Rep Wood x -> Wood
forall x. Wood -> Rep Wood x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wood x -> Wood
$cfrom :: forall x. Wood -> Rep Wood x
Generic,Int -> Wood -> ShowS
[Wood] -> ShowS
Wood -> String
(Int -> Wood -> ShowS)
-> (Wood -> String) -> ([Wood] -> ShowS) -> Show Wood
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wood] -> ShowS
$cshowList :: [Wood] -> ShowS
show :: Wood -> String
$cshow :: Wood -> String
showsPrec :: Int -> Wood -> ShowS
$cshowsPrec :: Int -> Wood -> ShowS
Show,Eq Wood
Eq Wood
-> (Wood -> Wood -> Ordering)
-> (Wood -> Wood -> Bool)
-> (Wood -> Wood -> Bool)
-> (Wood -> Wood -> Bool)
-> (Wood -> Wood -> Bool)
-> (Wood -> Wood -> Wood)
-> (Wood -> Wood -> Wood)
-> Ord Wood
Wood -> Wood -> Bool
Wood -> Wood -> Ordering
Wood -> Wood -> Wood
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Wood -> Wood -> Wood
$cmin :: Wood -> Wood -> Wood
max :: Wood -> Wood -> Wood
$cmax :: Wood -> Wood -> Wood
>= :: Wood -> Wood -> Bool
$c>= :: Wood -> Wood -> Bool
> :: Wood -> Wood -> Bool
$c> :: Wood -> Wood -> Bool
<= :: Wood -> Wood -> Bool
$c<= :: Wood -> Wood -> Bool
< :: Wood -> Wood -> Bool
$c< :: Wood -> Wood -> Bool
compare :: Wood -> Wood -> Ordering
$ccompare :: Wood -> Wood -> Ordering
$cp1Ord :: Eq Wood
Ord,Int -> Wood
Wood -> Int
Wood -> [Wood]
Wood -> Wood
Wood -> Wood -> [Wood]
Wood -> Wood -> Wood -> [Wood]
(Wood -> Wood)
-> (Wood -> Wood)
-> (Int -> Wood)
-> (Wood -> Int)
-> (Wood -> [Wood])
-> (Wood -> Wood -> [Wood])
-> (Wood -> Wood -> [Wood])
-> (Wood -> Wood -> Wood -> [Wood])
-> Enum Wood
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Wood -> Wood -> Wood -> [Wood]
$cenumFromThenTo :: Wood -> Wood -> Wood -> [Wood]
enumFromTo :: Wood -> Wood -> [Wood]
$cenumFromTo :: Wood -> Wood -> [Wood]
enumFromThen :: Wood -> Wood -> [Wood]
$cenumFromThen :: Wood -> Wood -> [Wood]
enumFrom :: Wood -> [Wood]
$cenumFrom :: Wood -> [Wood]
fromEnum :: Wood -> Int
$cfromEnum :: Wood -> Int
toEnum :: Int -> Wood
$ctoEnum :: Int -> Wood
pred :: Wood -> Wood
$cpred :: Wood -> Wood
succ :: Wood -> Wood
$csucc :: Wood -> Wood
Enum,Wood
Wood -> Wood -> Bounded Wood
forall a. a -> a -> Bounded a
maxBound :: Wood
$cmaxBound :: Wood
minBound :: Wood
$cminBound :: Wood
Bounded)
instance EmitXml Wood where
    emitXml :: Wood -> XmlRep
emitXml Wood
WoodBambooScraper = String -> XmlRep
XLit String
"bamboo scraper"
    emitXml Wood
WoodBoardClapper = String -> XmlRep
XLit String
"board clapper"
    emitXml Wood
WoodCabasa = String -> XmlRep
XLit String
"cabasa"
    emitXml Wood
WoodCastanets = String -> XmlRep
XLit String
"castanets"
    emitXml Wood
WoodCastanetsWithHandle = String -> XmlRep
XLit String
"castanets with handle"
    emitXml Wood
WoodClaves = String -> XmlRep
XLit String
"claves"
    emitXml Wood
WoodFootballRattle = String -> XmlRep
XLit String
"football rattle"
    emitXml Wood
WoodGuiro = String -> XmlRep
XLit String
"guiro"
    emitXml Wood
WoodLogDrum = String -> XmlRep
XLit String
"log drum"
    emitXml Wood
WoodMaraca = String -> XmlRep
XLit String
"maraca"
    emitXml Wood
WoodMaracas = String -> XmlRep
XLit String
"maracas"
    emitXml Wood
WoodQuijada = String -> XmlRep
XLit String
"quijada"
    emitXml Wood
WoodRainstick = String -> XmlRep
XLit String
"rainstick"
    emitXml Wood
WoodRatchet = String -> XmlRep
XLit String
"ratchet"
    emitXml Wood
WoodRecoReco = String -> XmlRep
XLit String
"reco-reco"
    emitXml Wood
WoodSandpaperBlocks = String -> XmlRep
XLit String
"sandpaper blocks"
    emitXml Wood
WoodSlitDrum = String -> XmlRep
XLit String
"slit drum"
    emitXml Wood
WoodTempleBlock = String -> XmlRep
XLit String
"temple block"
    emitXml Wood
WoodVibraslap = String -> XmlRep
XLit String
"vibraslap"
    emitXml Wood
WoodWhip = String -> XmlRep
XLit String
"whip"
    emitXml Wood
WoodWoodBlock = String -> XmlRep
XLit String
"wood block"
parseWood :: String -> P.XParse Wood
parseWood :: String -> XParse Wood
parseWood String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bamboo scraper" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodBambooScraper
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"board clapper" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodBoardClapper
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"cabasa" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodCabasa
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"castanets" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodCastanets
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"castanets with handle" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodCastanetsWithHandle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"claves" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodClaves
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"football rattle" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodFootballRattle
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"guiro" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodGuiro
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"log drum" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodLogDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"maraca" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodMaraca
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"maracas" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodMaracas
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"quijada" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodQuijada
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"rainstick" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodRainstick
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ratchet" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodRatchet
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"reco-reco" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodRecoReco
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"sandpaper blocks" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodSandpaperBlocks
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"slit drum" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodSlitDrum
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"temple block" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodTempleBlock
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"vibraslap" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodVibraslap
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"whip" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodWhip
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"wood block" = Wood -> XParse Wood
forall (m :: * -> *) a. Monad m => a -> m a
return (Wood -> XParse Wood) -> Wood -> XParse Wood
forall a b. (a -> b) -> a -> b
$ Wood
WoodWoodBlock
        | Bool
otherwise = String -> XParse Wood
forall a. String -> XParse a
P.xfail (String -> XParse Wood) -> String -> XParse Wood
forall a b. (a -> b) -> a -> b
$ String
"Wood: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @yes-no@ /(simple)/
--
-- The yes-no type is used for boolean-like attributes. We cannot use W3C XML Schema booleans due to their restrictions on expression of boolean values.
data YesNo = 
      YesNoYes -- ^ /yes/
    | YesNoNo -- ^ /no/
    deriving (YesNo -> YesNo -> Bool
(YesNo -> YesNo -> Bool) -> (YesNo -> YesNo -> Bool) -> Eq YesNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YesNo -> YesNo -> Bool
$c/= :: YesNo -> YesNo -> Bool
== :: YesNo -> YesNo -> Bool
$c== :: YesNo -> YesNo -> Bool
Eq,Typeable,(forall x. YesNo -> Rep YesNo x)
-> (forall x. Rep YesNo x -> YesNo) -> Generic YesNo
forall x. Rep YesNo x -> YesNo
forall x. YesNo -> Rep YesNo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep YesNo x -> YesNo
$cfrom :: forall x. YesNo -> Rep YesNo x
Generic,Int -> YesNo -> ShowS
[YesNo] -> ShowS
YesNo -> String
(Int -> YesNo -> ShowS)
-> (YesNo -> String) -> ([YesNo] -> ShowS) -> Show YesNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [YesNo] -> ShowS
$cshowList :: [YesNo] -> ShowS
show :: YesNo -> String
$cshow :: YesNo -> String
showsPrec :: Int -> YesNo -> ShowS
$cshowsPrec :: Int -> YesNo -> ShowS
Show,Eq YesNo
Eq YesNo
-> (YesNo -> YesNo -> Ordering)
-> (YesNo -> YesNo -> Bool)
-> (YesNo -> YesNo -> Bool)
-> (YesNo -> YesNo -> Bool)
-> (YesNo -> YesNo -> Bool)
-> (YesNo -> YesNo -> YesNo)
-> (YesNo -> YesNo -> YesNo)
-> Ord YesNo
YesNo -> YesNo -> Bool
YesNo -> YesNo -> Ordering
YesNo -> YesNo -> YesNo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: YesNo -> YesNo -> YesNo
$cmin :: YesNo -> YesNo -> YesNo
max :: YesNo -> YesNo -> YesNo
$cmax :: YesNo -> YesNo -> YesNo
>= :: YesNo -> YesNo -> Bool
$c>= :: YesNo -> YesNo -> Bool
> :: YesNo -> YesNo -> Bool
$c> :: YesNo -> YesNo -> Bool
<= :: YesNo -> YesNo -> Bool
$c<= :: YesNo -> YesNo -> Bool
< :: YesNo -> YesNo -> Bool
$c< :: YesNo -> YesNo -> Bool
compare :: YesNo -> YesNo -> Ordering
$ccompare :: YesNo -> YesNo -> Ordering
$cp1Ord :: Eq YesNo
Ord,Int -> YesNo
YesNo -> Int
YesNo -> [YesNo]
YesNo -> YesNo
YesNo -> YesNo -> [YesNo]
YesNo -> YesNo -> YesNo -> [YesNo]
(YesNo -> YesNo)
-> (YesNo -> YesNo)
-> (Int -> YesNo)
-> (YesNo -> Int)
-> (YesNo -> [YesNo])
-> (YesNo -> YesNo -> [YesNo])
-> (YesNo -> YesNo -> [YesNo])
-> (YesNo -> YesNo -> YesNo -> [YesNo])
-> Enum YesNo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: YesNo -> YesNo -> YesNo -> [YesNo]
$cenumFromThenTo :: YesNo -> YesNo -> YesNo -> [YesNo]
enumFromTo :: YesNo -> YesNo -> [YesNo]
$cenumFromTo :: YesNo -> YesNo -> [YesNo]
enumFromThen :: YesNo -> YesNo -> [YesNo]
$cenumFromThen :: YesNo -> YesNo -> [YesNo]
enumFrom :: YesNo -> [YesNo]
$cenumFrom :: YesNo -> [YesNo]
fromEnum :: YesNo -> Int
$cfromEnum :: YesNo -> Int
toEnum :: Int -> YesNo
$ctoEnum :: Int -> YesNo
pred :: YesNo -> YesNo
$cpred :: YesNo -> YesNo
succ :: YesNo -> YesNo
$csucc :: YesNo -> YesNo
Enum,YesNo
YesNo -> YesNo -> Bounded YesNo
forall a. a -> a -> Bounded a
maxBound :: YesNo
$cmaxBound :: YesNo
minBound :: YesNo
$cminBound :: YesNo
Bounded)
instance EmitXml YesNo where
    emitXml :: YesNo -> XmlRep
emitXml YesNo
YesNoYes = String -> XmlRep
XLit String
"yes"
    emitXml YesNo
YesNoNo = String -> XmlRep
XLit String
"no"
parseYesNo :: String -> P.XParse YesNo
parseYesNo :: String -> XParse YesNo
parseYesNo String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yes" = YesNo -> XParse YesNo
forall (m :: * -> *) a. Monad m => a -> m a
return (YesNo -> XParse YesNo) -> YesNo -> XParse YesNo
forall a b. (a -> b) -> a -> b
$ YesNo
YesNoYes
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"no" = YesNo -> XParse YesNo
forall (m :: * -> *) a. Monad m => a -> m a
return (YesNo -> XParse YesNo) -> YesNo -> XParse YesNo
forall a b. (a -> b) -> a -> b
$ YesNo
YesNoNo
        | Bool
otherwise = String -> XParse YesNo
forall a. String -> XParse a
P.xfail (String -> XParse YesNo) -> String -> XParse YesNo
forall a b. (a -> b) -> a -> b
$ String
"YesNo: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @yes-no-number@ /(simple)/
--
-- The yes-no-number type is used for attributes that can be either boolean or numeric values.
data YesNoNumber = 
      YesNoNumberYesNo {
          YesNoNumber -> YesNo
yesNoNumber1 :: YesNo
       }
    | YesNoNumberDecimal {
          YesNoNumber -> Decimal
yesNoNumber2 :: Decimal
       }
    deriving (YesNoNumber -> YesNoNumber -> Bool
(YesNoNumber -> YesNoNumber -> Bool)
-> (YesNoNumber -> YesNoNumber -> Bool) -> Eq YesNoNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YesNoNumber -> YesNoNumber -> Bool
$c/= :: YesNoNumber -> YesNoNumber -> Bool
== :: YesNoNumber -> YesNoNumber -> Bool
$c== :: YesNoNumber -> YesNoNumber -> Bool
Eq,Typeable,(forall x. YesNoNumber -> Rep YesNoNumber x)
-> (forall x. Rep YesNoNumber x -> YesNoNumber)
-> Generic YesNoNumber
forall x. Rep YesNoNumber x -> YesNoNumber
forall x. YesNoNumber -> Rep YesNoNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep YesNoNumber x -> YesNoNumber
$cfrom :: forall x. YesNoNumber -> Rep YesNoNumber x
Generic,Int -> YesNoNumber -> ShowS
[YesNoNumber] -> ShowS
YesNoNumber -> String
(Int -> YesNoNumber -> ShowS)
-> (YesNoNumber -> String)
-> ([YesNoNumber] -> ShowS)
-> Show YesNoNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [YesNoNumber] -> ShowS
$cshowList :: [YesNoNumber] -> ShowS
show :: YesNoNumber -> String
$cshow :: YesNoNumber -> String
showsPrec :: Int -> YesNoNumber -> ShowS
$cshowsPrec :: Int -> YesNoNumber -> ShowS
Show)
instance EmitXml YesNoNumber where
    emitXml :: YesNoNumber -> XmlRep
emitXml (YesNoNumberYesNo YesNo
a) = YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml YesNo
a
    emitXml (YesNoNumberDecimal Decimal
a) = Decimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Decimal
a
parseYesNoNumber :: String -> P.XParse YesNoNumber
parseYesNoNumber :: String -> XParse YesNoNumber
parseYesNoNumber String
s = 
      YesNo -> YesNoNumber
YesNoNumberYesNo
        (YesNo -> YesNoNumber) -> XParse YesNo -> XParse YesNoNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> XParse YesNo
parseYesNo String
s
      XParse YesNoNumber -> XParse YesNoNumber -> XParse YesNoNumber
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Decimal -> YesNoNumber
YesNoNumberDecimal
        (Decimal -> YesNoNumber) -> XParse Decimal -> XParse YesNoNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String -> XParse Decimal
forall a. Read a => String -> String -> XParse a
P.xread String
"Decimal") String
s


-- | @yyyy-mm-dd@ /(simple)/
--
-- Calendar dates are represented yyyy-mm-dd format, following ISO 8601. This is a W3C XML Schema date type, but without the optional timezone data.
newtype YyyyMmDd = YyyyMmDd { YyyyMmDd -> String
yyyyMmDd :: String }
    deriving (YyyyMmDd -> YyyyMmDd -> Bool
(YyyyMmDd -> YyyyMmDd -> Bool)
-> (YyyyMmDd -> YyyyMmDd -> Bool) -> Eq YyyyMmDd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: YyyyMmDd -> YyyyMmDd -> Bool
$c/= :: YyyyMmDd -> YyyyMmDd -> Bool
== :: YyyyMmDd -> YyyyMmDd -> Bool
$c== :: YyyyMmDd -> YyyyMmDd -> Bool
Eq,Typeable,(forall x. YyyyMmDd -> Rep YyyyMmDd x)
-> (forall x. Rep YyyyMmDd x -> YyyyMmDd) -> Generic YyyyMmDd
forall x. Rep YyyyMmDd x -> YyyyMmDd
forall x. YyyyMmDd -> Rep YyyyMmDd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep YyyyMmDd x -> YyyyMmDd
$cfrom :: forall x. YyyyMmDd -> Rep YyyyMmDd x
Generic,Eq YyyyMmDd
Eq YyyyMmDd
-> (YyyyMmDd -> YyyyMmDd -> Ordering)
-> (YyyyMmDd -> YyyyMmDd -> Bool)
-> (YyyyMmDd -> YyyyMmDd -> Bool)
-> (YyyyMmDd -> YyyyMmDd -> Bool)
-> (YyyyMmDd -> YyyyMmDd -> Bool)
-> (YyyyMmDd -> YyyyMmDd -> YyyyMmDd)
-> (YyyyMmDd -> YyyyMmDd -> YyyyMmDd)
-> Ord YyyyMmDd
YyyyMmDd -> YyyyMmDd -> Bool
YyyyMmDd -> YyyyMmDd -> Ordering
YyyyMmDd -> YyyyMmDd -> YyyyMmDd
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: YyyyMmDd -> YyyyMmDd -> YyyyMmDd
$cmin :: YyyyMmDd -> YyyyMmDd -> YyyyMmDd
max :: YyyyMmDd -> YyyyMmDd -> YyyyMmDd
$cmax :: YyyyMmDd -> YyyyMmDd -> YyyyMmDd
>= :: YyyyMmDd -> YyyyMmDd -> Bool
$c>= :: YyyyMmDd -> YyyyMmDd -> Bool
> :: YyyyMmDd -> YyyyMmDd -> Bool
$c> :: YyyyMmDd -> YyyyMmDd -> Bool
<= :: YyyyMmDd -> YyyyMmDd -> Bool
$c<= :: YyyyMmDd -> YyyyMmDd -> Bool
< :: YyyyMmDd -> YyyyMmDd -> Bool
$c< :: YyyyMmDd -> YyyyMmDd -> Bool
compare :: YyyyMmDd -> YyyyMmDd -> Ordering
$ccompare :: YyyyMmDd -> YyyyMmDd -> Ordering
$cp1Ord :: Eq YyyyMmDd
Ord,String -> YyyyMmDd
(String -> YyyyMmDd) -> IsString YyyyMmDd
forall a. (String -> a) -> IsString a
fromString :: String -> YyyyMmDd
$cfromString :: String -> YyyyMmDd
IsString)
instance Show YyyyMmDd where show :: YyyyMmDd -> String
show (YyyyMmDd String
a) = ShowS
forall a. Show a => a -> String
show String
a
instance Read YyyyMmDd where readsPrec :: Int -> ReadS YyyyMmDd
readsPrec Int
i = ((String, String) -> (YyyyMmDd, String))
-> [(String, String)] -> [(YyyyMmDd, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> YyyyMmDd) -> (String, String) -> (YyyyMmDd, String)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first String -> YyyyMmDd
YyyyMmDd) ([(String, String)] -> [(YyyyMmDd, String)])
-> (String -> [(String, String)]) -> ReadS YyyyMmDd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [(String, String)]
forall a. Read a => Int -> ReadS a
readsPrec Int
i
instance EmitXml YyyyMmDd where
    emitXml :: YyyyMmDd -> XmlRep
emitXml = String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml (String -> XmlRep) -> (YyyyMmDd -> String) -> YyyyMmDd -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YyyyMmDd -> String
yyyyMmDd
parseYyyyMmDd :: String -> P.XParse YyyyMmDd
parseYyyyMmDd :: String -> XParse YyyyMmDd
parseYyyyMmDd = YyyyMmDd -> XParse YyyyMmDd
forall (m :: * -> *) a. Monad m => a -> m a
return (YyyyMmDd -> XParse YyyyMmDd)
-> (String -> YyyyMmDd) -> String -> XParse YyyyMmDd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> YyyyMmDd
forall a. IsString a => String -> a
fromString

-- | @xml:lang@ /(union)/
data SumLang = 
      SumLang -- ^ //
    deriving (SumLang -> SumLang -> Bool
(SumLang -> SumLang -> Bool)
-> (SumLang -> SumLang -> Bool) -> Eq SumLang
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumLang -> SumLang -> Bool
$c/= :: SumLang -> SumLang -> Bool
== :: SumLang -> SumLang -> Bool
$c== :: SumLang -> SumLang -> Bool
Eq,Typeable,(forall x. SumLang -> Rep SumLang x)
-> (forall x. Rep SumLang x -> SumLang) -> Generic SumLang
forall x. Rep SumLang x -> SumLang
forall x. SumLang -> Rep SumLang x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SumLang x -> SumLang
$cfrom :: forall x. SumLang -> Rep SumLang x
Generic,Int -> SumLang -> ShowS
[SumLang] -> ShowS
SumLang -> String
(Int -> SumLang -> ShowS)
-> (SumLang -> String) -> ([SumLang] -> ShowS) -> Show SumLang
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumLang] -> ShowS
$cshowList :: [SumLang] -> ShowS
show :: SumLang -> String
$cshow :: SumLang -> String
showsPrec :: Int -> SumLang -> ShowS
$cshowsPrec :: Int -> SumLang -> ShowS
Show,Eq SumLang
Eq SumLang
-> (SumLang -> SumLang -> Ordering)
-> (SumLang -> SumLang -> Bool)
-> (SumLang -> SumLang -> Bool)
-> (SumLang -> SumLang -> Bool)
-> (SumLang -> SumLang -> Bool)
-> (SumLang -> SumLang -> SumLang)
-> (SumLang -> SumLang -> SumLang)
-> Ord SumLang
SumLang -> SumLang -> Bool
SumLang -> SumLang -> Ordering
SumLang -> SumLang -> SumLang
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SumLang -> SumLang -> SumLang
$cmin :: SumLang -> SumLang -> SumLang
max :: SumLang -> SumLang -> SumLang
$cmax :: SumLang -> SumLang -> SumLang
>= :: SumLang -> SumLang -> Bool
$c>= :: SumLang -> SumLang -> Bool
> :: SumLang -> SumLang -> Bool
$c> :: SumLang -> SumLang -> Bool
<= :: SumLang -> SumLang -> Bool
$c<= :: SumLang -> SumLang -> Bool
< :: SumLang -> SumLang -> Bool
$c< :: SumLang -> SumLang -> Bool
compare :: SumLang -> SumLang -> Ordering
$ccompare :: SumLang -> SumLang -> Ordering
$cp1Ord :: Eq SumLang
Ord,Int -> SumLang
SumLang -> Int
SumLang -> [SumLang]
SumLang -> SumLang
SumLang -> SumLang -> [SumLang]
SumLang -> SumLang -> SumLang -> [SumLang]
(SumLang -> SumLang)
-> (SumLang -> SumLang)
-> (Int -> SumLang)
-> (SumLang -> Int)
-> (SumLang -> [SumLang])
-> (SumLang -> SumLang -> [SumLang])
-> (SumLang -> SumLang -> [SumLang])
-> (SumLang -> SumLang -> SumLang -> [SumLang])
-> Enum SumLang
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SumLang -> SumLang -> SumLang -> [SumLang]
$cenumFromThenTo :: SumLang -> SumLang -> SumLang -> [SumLang]
enumFromTo :: SumLang -> SumLang -> [SumLang]
$cenumFromTo :: SumLang -> SumLang -> [SumLang]
enumFromThen :: SumLang -> SumLang -> [SumLang]
$cenumFromThen :: SumLang -> SumLang -> [SumLang]
enumFrom :: SumLang -> [SumLang]
$cenumFrom :: SumLang -> [SumLang]
fromEnum :: SumLang -> Int
$cfromEnum :: SumLang -> Int
toEnum :: Int -> SumLang
$ctoEnum :: Int -> SumLang
pred :: SumLang -> SumLang
$cpred :: SumLang -> SumLang
succ :: SumLang -> SumLang
$csucc :: SumLang -> SumLang
Enum,SumLang
SumLang -> SumLang -> Bounded SumLang
forall a. a -> a -> Bounded a
maxBound :: SumLang
$cmaxBound :: SumLang
minBound :: SumLang
$cminBound :: SumLang
Bounded)
instance EmitXml SumLang where
    emitXml :: SumLang -> XmlRep
emitXml SumLang
SumLang = String -> XmlRep
XLit String
""
parseSumLang :: String -> P.XParse SumLang
parseSumLang :: String -> XParse SumLang
parseSumLang String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = SumLang -> XParse SumLang
forall (m :: * -> *) a. Monad m => a -> m a
return (SumLang -> XParse SumLang) -> SumLang -> XParse SumLang
forall a b. (a -> b) -> a -> b
$ SumLang
SumLang
        | Bool
otherwise = String -> XParse SumLang
forall a. String -> XParse a
P.xfail (String -> XParse SumLang) -> String -> XParse SumLang
forall a b. (a -> b) -> a -> b
$ String
"SumLang: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @number-or-normal@ /(union)/
data SumNumberOrNormal = 
      NumberOrNormalNormal -- ^ /normal/
    deriving (SumNumberOrNormal -> SumNumberOrNormal -> Bool
(SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> (SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> Eq SumNumberOrNormal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c/= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
== :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c== :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
Eq,Typeable,(forall x. SumNumberOrNormal -> Rep SumNumberOrNormal x)
-> (forall x. Rep SumNumberOrNormal x -> SumNumberOrNormal)
-> Generic SumNumberOrNormal
forall x. Rep SumNumberOrNormal x -> SumNumberOrNormal
forall x. SumNumberOrNormal -> Rep SumNumberOrNormal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SumNumberOrNormal x -> SumNumberOrNormal
$cfrom :: forall x. SumNumberOrNormal -> Rep SumNumberOrNormal x
Generic,Int -> SumNumberOrNormal -> ShowS
[SumNumberOrNormal] -> ShowS
SumNumberOrNormal -> String
(Int -> SumNumberOrNormal -> ShowS)
-> (SumNumberOrNormal -> String)
-> ([SumNumberOrNormal] -> ShowS)
-> Show SumNumberOrNormal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumNumberOrNormal] -> ShowS
$cshowList :: [SumNumberOrNormal] -> ShowS
show :: SumNumberOrNormal -> String
$cshow :: SumNumberOrNormal -> String
showsPrec :: Int -> SumNumberOrNormal -> ShowS
$cshowsPrec :: Int -> SumNumberOrNormal -> ShowS
Show,Eq SumNumberOrNormal
Eq SumNumberOrNormal
-> (SumNumberOrNormal -> SumNumberOrNormal -> Ordering)
-> (SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> (SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> (SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> (SumNumberOrNormal -> SumNumberOrNormal -> Bool)
-> (SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal)
-> (SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal)
-> Ord SumNumberOrNormal
SumNumberOrNormal -> SumNumberOrNormal -> Bool
SumNumberOrNormal -> SumNumberOrNormal -> Ordering
SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal
$cmin :: SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal
max :: SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal
$cmax :: SumNumberOrNormal -> SumNumberOrNormal -> SumNumberOrNormal
>= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c>= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
> :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c> :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
<= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c<= :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
< :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
$c< :: SumNumberOrNormal -> SumNumberOrNormal -> Bool
compare :: SumNumberOrNormal -> SumNumberOrNormal -> Ordering
$ccompare :: SumNumberOrNormal -> SumNumberOrNormal -> Ordering
$cp1Ord :: Eq SumNumberOrNormal
Ord,Int -> SumNumberOrNormal
SumNumberOrNormal -> Int
SumNumberOrNormal -> [SumNumberOrNormal]
SumNumberOrNormal -> SumNumberOrNormal
SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
SumNumberOrNormal
-> SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
(SumNumberOrNormal -> SumNumberOrNormal)
-> (SumNumberOrNormal -> SumNumberOrNormal)
-> (Int -> SumNumberOrNormal)
-> (SumNumberOrNormal -> Int)
-> (SumNumberOrNormal -> [SumNumberOrNormal])
-> (SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal])
-> (SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal])
-> (SumNumberOrNormal
    -> SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal])
-> Enum SumNumberOrNormal
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SumNumberOrNormal
-> SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
$cenumFromThenTo :: SumNumberOrNormal
-> SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
enumFromTo :: SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
$cenumFromTo :: SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
enumFromThen :: SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
$cenumFromThen :: SumNumberOrNormal -> SumNumberOrNormal -> [SumNumberOrNormal]
enumFrom :: SumNumberOrNormal -> [SumNumberOrNormal]
$cenumFrom :: SumNumberOrNormal -> [SumNumberOrNormal]
fromEnum :: SumNumberOrNormal -> Int
$cfromEnum :: SumNumberOrNormal -> Int
toEnum :: Int -> SumNumberOrNormal
$ctoEnum :: Int -> SumNumberOrNormal
pred :: SumNumberOrNormal -> SumNumberOrNormal
$cpred :: SumNumberOrNormal -> SumNumberOrNormal
succ :: SumNumberOrNormal -> SumNumberOrNormal
$csucc :: SumNumberOrNormal -> SumNumberOrNormal
Enum,SumNumberOrNormal
SumNumberOrNormal -> SumNumberOrNormal -> Bounded SumNumberOrNormal
forall a. a -> a -> Bounded a
maxBound :: SumNumberOrNormal
$cmaxBound :: SumNumberOrNormal
minBound :: SumNumberOrNormal
$cminBound :: SumNumberOrNormal
Bounded)
instance EmitXml SumNumberOrNormal where
    emitXml :: SumNumberOrNormal -> XmlRep
emitXml SumNumberOrNormal
NumberOrNormalNormal = String -> XmlRep
XLit String
"normal"
parseSumNumberOrNormal :: String -> P.XParse SumNumberOrNormal
parseSumNumberOrNormal :: String -> XParse SumNumberOrNormal
parseSumNumberOrNormal String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"normal" = SumNumberOrNormal -> XParse SumNumberOrNormal
forall (m :: * -> *) a. Monad m => a -> m a
return (SumNumberOrNormal -> XParse SumNumberOrNormal)
-> SumNumberOrNormal -> XParse SumNumberOrNormal
forall a b. (a -> b) -> a -> b
$ SumNumberOrNormal
NumberOrNormalNormal
        | Bool
otherwise = String -> XParse SumNumberOrNormal
forall a. String -> XParse a
P.xfail (String -> XParse SumNumberOrNormal)
-> String -> XParse SumNumberOrNormal
forall a b. (a -> b) -> a -> b
$ String
"SumNumberOrNormal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @positive-integer-or-empty@ /(union)/
data SumPositiveIntegerOrEmpty = 
      SumPositiveIntegerOrEmpty -- ^ //
    deriving (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
(SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> Eq SumPositiveIntegerOrEmpty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c/= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
== :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c== :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
Eq,Typeable,(forall x.
 SumPositiveIntegerOrEmpty -> Rep SumPositiveIntegerOrEmpty x)
-> (forall x.
    Rep SumPositiveIntegerOrEmpty x -> SumPositiveIntegerOrEmpty)
-> Generic SumPositiveIntegerOrEmpty
forall x.
Rep SumPositiveIntegerOrEmpty x -> SumPositiveIntegerOrEmpty
forall x.
SumPositiveIntegerOrEmpty -> Rep SumPositiveIntegerOrEmpty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SumPositiveIntegerOrEmpty x -> SumPositiveIntegerOrEmpty
$cfrom :: forall x.
SumPositiveIntegerOrEmpty -> Rep SumPositiveIntegerOrEmpty x
Generic,Int -> SumPositiveIntegerOrEmpty -> ShowS
[SumPositiveIntegerOrEmpty] -> ShowS
SumPositiveIntegerOrEmpty -> String
(Int -> SumPositiveIntegerOrEmpty -> ShowS)
-> (SumPositiveIntegerOrEmpty -> String)
-> ([SumPositiveIntegerOrEmpty] -> ShowS)
-> Show SumPositiveIntegerOrEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumPositiveIntegerOrEmpty] -> ShowS
$cshowList :: [SumPositiveIntegerOrEmpty] -> ShowS
show :: SumPositiveIntegerOrEmpty -> String
$cshow :: SumPositiveIntegerOrEmpty -> String
showsPrec :: Int -> SumPositiveIntegerOrEmpty -> ShowS
$cshowsPrec :: Int -> SumPositiveIntegerOrEmpty -> ShowS
Show,Eq SumPositiveIntegerOrEmpty
Eq SumPositiveIntegerOrEmpty
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty -> Ordering)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool)
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty)
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty)
-> Ord SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Ordering
SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
$cmin :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
max :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
$cmax :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
>= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c>= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
> :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c> :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
<= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c<= :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
< :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
$c< :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Bool
compare :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Ordering
$ccompare :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty -> Ordering
$cp1Ord :: Eq SumPositiveIntegerOrEmpty
Ord,Int -> SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty -> Int
SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> [SumPositiveIntegerOrEmpty]
(SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty)
-> (SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty)
-> (Int -> SumPositiveIntegerOrEmpty)
-> (SumPositiveIntegerOrEmpty -> Int)
-> (SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty])
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty])
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty])
-> (SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty
    -> SumPositiveIntegerOrEmpty
    -> [SumPositiveIntegerOrEmpty])
-> Enum SumPositiveIntegerOrEmpty
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> [SumPositiveIntegerOrEmpty]
$cenumFromThenTo :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty
-> [SumPositiveIntegerOrEmpty]
enumFromTo :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
$cenumFromTo :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
enumFromThen :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
$cenumFromThen :: SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
enumFrom :: SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
$cenumFrom :: SumPositiveIntegerOrEmpty -> [SumPositiveIntegerOrEmpty]
fromEnum :: SumPositiveIntegerOrEmpty -> Int
$cfromEnum :: SumPositiveIntegerOrEmpty -> Int
toEnum :: Int -> SumPositiveIntegerOrEmpty
$ctoEnum :: Int -> SumPositiveIntegerOrEmpty
pred :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
$cpred :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
succ :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
$csucc :: SumPositiveIntegerOrEmpty -> SumPositiveIntegerOrEmpty
Enum,SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty
-> SumPositiveIntegerOrEmpty -> Bounded SumPositiveIntegerOrEmpty
forall a. a -> a -> Bounded a
maxBound :: SumPositiveIntegerOrEmpty
$cmaxBound :: SumPositiveIntegerOrEmpty
minBound :: SumPositiveIntegerOrEmpty
$cminBound :: SumPositiveIntegerOrEmpty
Bounded)
instance EmitXml SumPositiveIntegerOrEmpty where
    emitXml :: SumPositiveIntegerOrEmpty -> XmlRep
emitXml SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty = String -> XmlRep
XLit String
""
parseSumPositiveIntegerOrEmpty :: String -> P.XParse SumPositiveIntegerOrEmpty
parseSumPositiveIntegerOrEmpty :: String -> XParse SumPositiveIntegerOrEmpty
parseSumPositiveIntegerOrEmpty String
s
        | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = SumPositiveIntegerOrEmpty -> XParse SumPositiveIntegerOrEmpty
forall (m :: * -> *) a. Monad m => a -> m a
return (SumPositiveIntegerOrEmpty -> XParse SumPositiveIntegerOrEmpty)
-> SumPositiveIntegerOrEmpty -> XParse SumPositiveIntegerOrEmpty
forall a b. (a -> b) -> a -> b
$ SumPositiveIntegerOrEmpty
SumPositiveIntegerOrEmpty
        | Bool
otherwise = String -> XParse SumPositiveIntegerOrEmpty
forall a. String -> XParse a
P.xfail (String -> XParse SumPositiveIntegerOrEmpty)
-> String -> XParse SumPositiveIntegerOrEmpty
forall a b. (a -> b) -> a -> b
$ String
"SumPositiveIntegerOrEmpty: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | @accidental@ /(complex)/
--
-- The accidental type represents actual notated accidentals. Editorial and cautionary indications are indicated by attributes. Values for these attributes are "no" if not present. Specific graphic display such as parentheses, brackets, and size are controlled by the level-display attribute group.
data Accidental = 
      Accidental {
          Accidental -> AccidentalValue
accidentalAccidentalValue :: AccidentalValue -- ^ text content
        , Accidental -> Maybe YesNo
accidentalCautionary :: (Maybe YesNo) -- ^ /cautionary/ attribute
        , Accidental -> Maybe YesNo
accidentalEditorial :: (Maybe YesNo) -- ^ /editorial/ attribute
        , Accidental -> Maybe SmuflAccidentalGlyphName
accidentalSmufl :: (Maybe SmuflAccidentalGlyphName) -- ^ /smufl/ attribute
        , Accidental -> Maybe YesNo
accidentalParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , Accidental -> Maybe YesNo
accidentalBracket :: (Maybe YesNo) -- ^ /bracket/ attribute
        , Accidental -> Maybe SymbolSize
accidentalSize :: (Maybe SymbolSize) -- ^ /size/ attribute
        , Accidental -> Maybe Tenths
accidentalDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Accidental -> Maybe Tenths
accidentalDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Accidental -> Maybe Tenths
accidentalRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Accidental -> Maybe Tenths
accidentalRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Accidental -> Maybe CommaSeparatedText
accidentalFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Accidental -> Maybe FontStyle
accidentalFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Accidental -> Maybe FontSize
accidentalFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Accidental -> Maybe FontWeight
accidentalFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Accidental -> Maybe Color
accidentalColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Accidental -> Accidental -> Bool
(Accidental -> Accidental -> Bool)
-> (Accidental -> Accidental -> Bool) -> Eq Accidental
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accidental -> Accidental -> Bool
$c/= :: Accidental -> Accidental -> Bool
== :: Accidental -> Accidental -> Bool
$c== :: Accidental -> Accidental -> Bool
Eq,Typeable,(forall x. Accidental -> Rep Accidental x)
-> (forall x. Rep Accidental x -> Accidental) -> Generic Accidental
forall x. Rep Accidental x -> Accidental
forall x. Accidental -> Rep Accidental x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Accidental x -> Accidental
$cfrom :: forall x. Accidental -> Rep Accidental x
Generic,Int -> Accidental -> ShowS
[Accidental] -> ShowS
Accidental -> String
(Int -> Accidental -> ShowS)
-> (Accidental -> String)
-> ([Accidental] -> ShowS)
-> Show Accidental
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accidental] -> ShowS
$cshowList :: [Accidental] -> ShowS
show :: Accidental -> String
$cshow :: Accidental -> String
showsPrec :: Int -> Accidental -> ShowS
$cshowsPrec :: Int -> Accidental -> ShowS
Show)
instance EmitXml Accidental where
    emitXml :: Accidental -> XmlRep
emitXml (Accidental AccidentalValue
a Maybe YesNo
b Maybe YesNo
c Maybe SmuflAccidentalGlyphName
d Maybe YesNo
e Maybe YesNo
f Maybe SymbolSize
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe Tenths
k Maybe CommaSeparatedText
l Maybe FontStyle
m Maybe FontSize
n Maybe FontWeight
o Maybe Color
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (AccidentalValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalValue
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"cautionary" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"editorial" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflAccidentalGlyphName -> XmlRep)
-> Maybe SmuflAccidentalGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflAccidentalGlyphName -> XmlRep)
-> SmuflAccidentalGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflAccidentalGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflAccidentalGlyphName
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SymbolSize -> XmlRep) -> Maybe SymbolSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SymbolSize -> XmlRep) -> SymbolSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SymbolSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SymbolSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
p])
        []
parseAccidental :: P.XParse Accidental
parseAccidental :: XParse Accidental
parseAccidental = 
      AccidentalValue
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SmuflAccidentalGlyphName
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Accidental
Accidental
        (AccidentalValue
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe SmuflAccidentalGlyphName
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe SymbolSize
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Accidental)
-> XParse AccidentalValue
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe SmuflAccidentalGlyphName
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse AccidentalValue) -> XParse AccidentalValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AccidentalValue
parseAccidentalValue)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe SmuflAccidentalGlyphName
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe SmuflAccidentalGlyphName
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"cautionary") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe SmuflAccidentalGlyphName
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe SmuflAccidentalGlyphName
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"editorial") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe SmuflAccidentalGlyphName
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe SmuflAccidentalGlyphName)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflAccidentalGlyphName
-> XParse (Maybe SmuflAccidentalGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflAccidentalGlyphName)
-> XParse SmuflAccidentalGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe SymbolSize)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SymbolSize -> XParse (Maybe SymbolSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String -> (String -> XParse SymbolSize) -> XParse SymbolSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SymbolSize
parseSymbolSize)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Accidental)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Accidental)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Accidental)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Accidental)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Accidental)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Accidental)
-> XParse (Maybe Color) -> XParse Accidental
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Accidental'
mkAccidental :: AccidentalValue -> Accidental
mkAccidental :: AccidentalValue -> Accidental
mkAccidental AccidentalValue
a = AccidentalValue
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SmuflAccidentalGlyphName
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Accidental
Accidental AccidentalValue
a Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe SmuflAccidentalGlyphName
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe SymbolSize
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @accidental-mark@ /(complex)/
--
-- An accidental-mark can be used as a separate notation or as part of an ornament. When used in an ornament, position and placement are relative to the ornament, not relative to the note.
data AccidentalMark = 
      AccidentalMark {
          AccidentalMark -> AccidentalValue
accidentalMarkAccidentalValue :: AccidentalValue -- ^ text content
        , AccidentalMark -> Maybe SmuflAccidentalGlyphName
accidentalMarkSmufl :: (Maybe SmuflAccidentalGlyphName) -- ^ /smufl/ attribute
        , AccidentalMark -> Maybe YesNo
accidentalMarkParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , AccidentalMark -> Maybe YesNo
accidentalMarkBracket :: (Maybe YesNo) -- ^ /bracket/ attribute
        , AccidentalMark -> Maybe SymbolSize
accidentalMarkSize :: (Maybe SymbolSize) -- ^ /size/ attribute
        , AccidentalMark -> Maybe Tenths
accidentalMarkDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , AccidentalMark -> Maybe Tenths
accidentalMarkDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , AccidentalMark -> Maybe Tenths
accidentalMarkRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , AccidentalMark -> Maybe Tenths
accidentalMarkRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , AccidentalMark -> Maybe CommaSeparatedText
accidentalMarkFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , AccidentalMark -> Maybe FontStyle
accidentalMarkFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , AccidentalMark -> Maybe FontSize
accidentalMarkFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , AccidentalMark -> Maybe FontWeight
accidentalMarkFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , AccidentalMark -> Maybe Color
accidentalMarkColor :: (Maybe Color) -- ^ /color/ attribute
        , AccidentalMark -> Maybe AboveBelow
accidentalMarkPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , AccidentalMark -> Maybe ID
accidentalMarkId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (AccidentalMark -> AccidentalMark -> Bool
(AccidentalMark -> AccidentalMark -> Bool)
-> (AccidentalMark -> AccidentalMark -> Bool) -> Eq AccidentalMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccidentalMark -> AccidentalMark -> Bool
$c/= :: AccidentalMark -> AccidentalMark -> Bool
== :: AccidentalMark -> AccidentalMark -> Bool
$c== :: AccidentalMark -> AccidentalMark -> Bool
Eq,Typeable,(forall x. AccidentalMark -> Rep AccidentalMark x)
-> (forall x. Rep AccidentalMark x -> AccidentalMark)
-> Generic AccidentalMark
forall x. Rep AccidentalMark x -> AccidentalMark
forall x. AccidentalMark -> Rep AccidentalMark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccidentalMark x -> AccidentalMark
$cfrom :: forall x. AccidentalMark -> Rep AccidentalMark x
Generic,Int -> AccidentalMark -> ShowS
[AccidentalMark] -> ShowS
AccidentalMark -> String
(Int -> AccidentalMark -> ShowS)
-> (AccidentalMark -> String)
-> ([AccidentalMark] -> ShowS)
-> Show AccidentalMark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccidentalMark] -> ShowS
$cshowList :: [AccidentalMark] -> ShowS
show :: AccidentalMark -> String
$cshow :: AccidentalMark -> String
showsPrec :: Int -> AccidentalMark -> ShowS
$cshowsPrec :: Int -> AccidentalMark -> ShowS
Show)
instance EmitXml AccidentalMark where
    emitXml :: AccidentalMark -> XmlRep
emitXml (AccidentalMark AccidentalValue
a Maybe SmuflAccidentalGlyphName
b Maybe YesNo
c Maybe YesNo
d Maybe SymbolSize
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe CommaSeparatedText
j Maybe FontStyle
k Maybe FontSize
l Maybe FontWeight
m Maybe Color
n Maybe AboveBelow
o Maybe ID
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (AccidentalValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalValue
a)
        ([XmlRep
-> (SmuflAccidentalGlyphName -> XmlRep)
-> Maybe SmuflAccidentalGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflAccidentalGlyphName -> XmlRep)
-> SmuflAccidentalGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflAccidentalGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflAccidentalGlyphName
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SymbolSize -> XmlRep) -> Maybe SymbolSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SymbolSize -> XmlRep) -> SymbolSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SymbolSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SymbolSize
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
p])
        []
parseAccidentalMark :: P.XParse AccidentalMark
parseAccidentalMark :: XParse AccidentalMark
parseAccidentalMark = 
      AccidentalValue
-> Maybe SmuflAccidentalGlyphName
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ID
-> AccidentalMark
AccidentalMark
        (AccidentalValue
 -> Maybe SmuflAccidentalGlyphName
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe SymbolSize
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe ID
 -> AccidentalMark)
-> XParse AccidentalValue
-> XParse
     (Maybe SmuflAccidentalGlyphName
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse AccidentalValue) -> XParse AccidentalValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AccidentalValue
parseAccidentalValue)
        XParse
  (Maybe SmuflAccidentalGlyphName
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe SmuflAccidentalGlyphName)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflAccidentalGlyphName
-> XParse (Maybe SmuflAccidentalGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflAccidentalGlyphName)
-> XParse SmuflAccidentalGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe SymbolSize
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe SymbolSize
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe SymbolSize)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SymbolSize -> XParse (Maybe SymbolSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String -> (String -> XParse SymbolSize) -> XParse SymbolSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SymbolSize
parseSymbolSize)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> AccidentalMark)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe AboveBelow -> Maybe ID -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe AboveBelow -> Maybe ID -> AccidentalMark)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color -> Maybe AboveBelow -> Maybe ID -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color -> Maybe AboveBelow -> Maybe ID -> AccidentalMark)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> Maybe ID -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Maybe ID -> AccidentalMark)
-> XParse (Maybe AboveBelow) -> XParse (Maybe ID -> AccidentalMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe ID -> AccidentalMark)
-> XParse (Maybe ID) -> XParse AccidentalMark
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'AccidentalMark'
mkAccidentalMark :: AccidentalValue -> AccidentalMark
mkAccidentalMark :: AccidentalValue -> AccidentalMark
mkAccidentalMark AccidentalValue
a = AccidentalValue
-> Maybe SmuflAccidentalGlyphName
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ID
-> AccidentalMark
AccidentalMark AccidentalValue
a Maybe SmuflAccidentalGlyphName
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe SymbolSize
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @accidental-text@ /(complex)/
--
-- The accidental-text type represents an element with an accidental value and text-formatting attributes.
data AccidentalText = 
      AccidentalText {
          AccidentalText -> AccidentalValue
accidentalTextAccidentalValue :: AccidentalValue -- ^ text content
        , AccidentalText -> Maybe SmuflAccidentalGlyphName
accidentalTextSmufl :: (Maybe SmuflAccidentalGlyphName) -- ^ /smufl/ attribute
        , AccidentalText -> Maybe Lang
accidentalTextLang :: (Maybe Lang) -- ^ /xml:lang/ attribute
        , AccidentalText -> Maybe Space
accidentalTextSpace :: (Maybe Space) -- ^ /xml:space/ attribute
        , AccidentalText -> Maybe LeftCenterRight
accidentalTextJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , AccidentalText -> Maybe Tenths
accidentalTextDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , AccidentalText -> Maybe Tenths
accidentalTextDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , AccidentalText -> Maybe Tenths
accidentalTextRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , AccidentalText -> Maybe Tenths
accidentalTextRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , AccidentalText -> Maybe CommaSeparatedText
accidentalTextFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , AccidentalText -> Maybe FontStyle
accidentalTextFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , AccidentalText -> Maybe FontSize
accidentalTextFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , AccidentalText -> Maybe FontWeight
accidentalTextFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , AccidentalText -> Maybe Color
accidentalTextColor :: (Maybe Color) -- ^ /color/ attribute
        , AccidentalText -> Maybe LeftCenterRight
accidentalTextHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , AccidentalText -> Maybe Valign
accidentalTextValign :: (Maybe Valign) -- ^ /valign/ attribute
        , AccidentalText -> Maybe NumberOfLines
accidentalTextUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , AccidentalText -> Maybe NumberOfLines
accidentalTextOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , AccidentalText -> Maybe NumberOfLines
accidentalTextLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , AccidentalText -> Maybe RotationDegrees
accidentalTextRotation :: (Maybe RotationDegrees) -- ^ /rotation/ attribute
        , AccidentalText -> Maybe NumberOrNormal
accidentalTextLetterSpacing :: (Maybe NumberOrNormal) -- ^ /letter-spacing/ attribute
        , AccidentalText -> Maybe NumberOrNormal
accidentalTextLineHeight :: (Maybe NumberOrNormal) -- ^ /line-height/ attribute
        , AccidentalText -> Maybe TextDirection
accidentalTextDir :: (Maybe TextDirection) -- ^ /dir/ attribute
        , AccidentalText -> Maybe EnclosureShape
accidentalTextEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
       }
    deriving (AccidentalText -> AccidentalText -> Bool
(AccidentalText -> AccidentalText -> Bool)
-> (AccidentalText -> AccidentalText -> Bool) -> Eq AccidentalText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccidentalText -> AccidentalText -> Bool
$c/= :: AccidentalText -> AccidentalText -> Bool
== :: AccidentalText -> AccidentalText -> Bool
$c== :: AccidentalText -> AccidentalText -> Bool
Eq,Typeable,(forall x. AccidentalText -> Rep AccidentalText x)
-> (forall x. Rep AccidentalText x -> AccidentalText)
-> Generic AccidentalText
forall x. Rep AccidentalText x -> AccidentalText
forall x. AccidentalText -> Rep AccidentalText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccidentalText x -> AccidentalText
$cfrom :: forall x. AccidentalText -> Rep AccidentalText x
Generic,Int -> AccidentalText -> ShowS
[AccidentalText] -> ShowS
AccidentalText -> String
(Int -> AccidentalText -> ShowS)
-> (AccidentalText -> String)
-> ([AccidentalText] -> ShowS)
-> Show AccidentalText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccidentalText] -> ShowS
$cshowList :: [AccidentalText] -> ShowS
show :: AccidentalText -> String
$cshow :: AccidentalText -> String
showsPrec :: Int -> AccidentalText -> ShowS
$cshowsPrec :: Int -> AccidentalText -> ShowS
Show)
instance EmitXml AccidentalText where
    emitXml :: AccidentalText -> XmlRep
emitXml (AccidentalText AccidentalValue
a Maybe SmuflAccidentalGlyphName
b Maybe Lang
c Maybe Space
d Maybe LeftCenterRight
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe CommaSeparatedText
j Maybe FontStyle
k Maybe FontSize
l Maybe FontWeight
m Maybe Color
n Maybe LeftCenterRight
o Maybe Valign
p Maybe NumberOfLines
q Maybe NumberOfLines
r Maybe NumberOfLines
s Maybe RotationDegrees
t Maybe NumberOrNormal
u Maybe NumberOrNormal
v Maybe TextDirection
w Maybe EnclosureShape
x) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (AccidentalValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalValue
a)
        ([XmlRep
-> (SmuflAccidentalGlyphName -> XmlRep)
-> Maybe SmuflAccidentalGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflAccidentalGlyphName -> XmlRep)
-> SmuflAccidentalGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflAccidentalGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflAccidentalGlyphName
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Lang -> XmlRep) -> Maybe Lang -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Lang -> XmlRep) -> Lang -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Lang
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Space -> XmlRep) -> Maybe Space -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Space -> XmlRep) -> Space -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Space -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Space
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"rotation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
t] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"letter-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
u] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
v] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TextDirection -> XmlRep) -> Maybe TextDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dir" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TextDirection -> XmlRep) -> TextDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TextDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TextDirection
w] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
x])
        []
parseAccidentalText :: P.XParse AccidentalText
parseAccidentalText :: XParse AccidentalText
parseAccidentalText = 
      AccidentalValue
-> Maybe SmuflAccidentalGlyphName
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> AccidentalText
AccidentalText
        (AccidentalValue
 -> Maybe SmuflAccidentalGlyphName
 -> Maybe Lang
 -> Maybe Space
 -> Maybe LeftCenterRight
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe RotationDegrees
 -> Maybe NumberOrNormal
 -> Maybe NumberOrNormal
 -> Maybe TextDirection
 -> Maybe EnclosureShape
 -> AccidentalText)
-> XParse AccidentalValue
-> XParse
     (Maybe SmuflAccidentalGlyphName
      -> Maybe Lang
      -> Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse AccidentalValue) -> XParse AccidentalValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AccidentalValue
parseAccidentalValue)
        XParse
  (Maybe SmuflAccidentalGlyphName
   -> Maybe Lang
   -> Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe SmuflAccidentalGlyphName)
-> XParse
     (Maybe Lang
      -> Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflAccidentalGlyphName
-> XParse (Maybe SmuflAccidentalGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflAccidentalGlyphName)
-> XParse SmuflAccidentalGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName)
        XParse
  (Maybe Lang
   -> Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Lang)
-> XParse
     (Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lang -> XParse (Maybe Lang)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)
        XParse
  (Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Space)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Space -> XParse (Maybe Space)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:space") XParse String -> (String -> XParse Space) -> XParse Space
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Space
parseSpace)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe Valign)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"rotation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> AccidentalText)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe TextDirection -> Maybe EnclosureShape -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"letter-spacing") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe NumberOrNormal
   -> Maybe TextDirection -> Maybe EnclosureShape -> AccidentalText)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe TextDirection -> Maybe EnclosureShape -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-height") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe TextDirection -> Maybe EnclosureShape -> AccidentalText)
-> XParse (Maybe TextDirection)
-> XParse (Maybe EnclosureShape -> AccidentalText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TextDirection -> XParse (Maybe TextDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dir") XParse String
-> (String -> XParse TextDirection) -> XParse TextDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TextDirection
parseTextDirection)
        XParse (Maybe EnclosureShape -> AccidentalText)
-> XParse (Maybe EnclosureShape) -> XParse AccidentalText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)

-- | Smart constructor for 'AccidentalText'
mkAccidentalText :: AccidentalValue -> AccidentalText
mkAccidentalText :: AccidentalValue -> AccidentalText
mkAccidentalText AccidentalValue
a = AccidentalValue
-> Maybe SmuflAccidentalGlyphName
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> AccidentalText
AccidentalText AccidentalValue
a Maybe SmuflAccidentalGlyphName
forall a. Maybe a
Nothing Maybe Lang
forall a. Maybe a
Nothing Maybe Space
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe TextDirection
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing

-- | @accord@ /(complex)/
--
-- The accord type represents the tuning of a single string in the scordatura element. It uses the same group of elements as the staff-tuning element. Strings are numbered from high to low.
data Accord = 
      Accord {
          Accord -> Maybe StringNumber
accordString :: (Maybe StringNumber) -- ^ /string/ attribute
        , Accord -> Tuning
accordTuning :: Tuning
       }
    deriving (Accord -> Accord -> Bool
(Accord -> Accord -> Bool)
-> (Accord -> Accord -> Bool) -> Eq Accord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accord -> Accord -> Bool
$c/= :: Accord -> Accord -> Bool
== :: Accord -> Accord -> Bool
$c== :: Accord -> Accord -> Bool
Eq,Typeable,(forall x. Accord -> Rep Accord x)
-> (forall x. Rep Accord x -> Accord) -> Generic Accord
forall x. Rep Accord x -> Accord
forall x. Accord -> Rep Accord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Accord x -> Accord
$cfrom :: forall x. Accord -> Rep Accord x
Generic,Int -> Accord -> ShowS
[Accord] -> ShowS
Accord -> String
(Int -> Accord -> ShowS)
-> (Accord -> String) -> ([Accord] -> ShowS) -> Show Accord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accord] -> ShowS
$cshowList :: [Accord] -> ShowS
show :: Accord -> String
$cshow :: Accord -> String
showsPrec :: Int -> Accord -> ShowS
$cshowsPrec :: Int -> Accord -> ShowS
Show)
instance EmitXml Accord where
    emitXml :: Accord -> XmlRep
emitXml (Accord Maybe StringNumber
a Tuning
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StringNumber -> XmlRep) -> Maybe StringNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"string" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StringNumber -> XmlRep) -> StringNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StringNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StringNumber
a])
        ([Tuning -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tuning
b])
parseAccord :: P.XParse Accord
parseAccord :: XParse Accord
parseAccord = 
      Maybe StringNumber -> Tuning -> Accord
Accord
        (Maybe StringNumber -> Tuning -> Accord)
-> XParse (Maybe StringNumber) -> XParse (Tuning -> Accord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StringNumber -> XParse (Maybe StringNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"string") XParse String
-> (String -> XParse StringNumber) -> XParse StringNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StringNumber
parseStringNumber)
        XParse (Tuning -> Accord) -> XParse Tuning -> XParse Accord
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tuning
parseTuning

-- | Smart constructor for 'Accord'
mkAccord :: Tuning -> Accord
mkAccord :: Tuning -> Accord
mkAccord Tuning
b = Maybe StringNumber -> Tuning -> Accord
Accord Maybe StringNumber
forall a. Maybe a
Nothing Tuning
b

-- | @accordion-registration@ /(complex)/
--
-- The accordion-registration type is use for accordion registration symbols. These are circular symbols divided horizontally into high, middle, and low sections that correspond to 4', 8', and 16' pipes. Each accordion-high, accordion-middle, and accordion-low element represents the presence of one or more dots in the registration diagram. An accordion-registration element needs to have at least one of the child elements present.
data AccordionRegistration = 
      AccordionRegistration {
          AccordionRegistration -> Maybe Tenths
accordionRegistrationDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , AccordionRegistration -> Maybe Tenths
accordionRegistrationDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , AccordionRegistration -> Maybe Tenths
accordionRegistrationRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , AccordionRegistration -> Maybe Tenths
accordionRegistrationRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , AccordionRegistration -> Maybe CommaSeparatedText
accordionRegistrationFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , AccordionRegistration -> Maybe FontStyle
accordionRegistrationFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , AccordionRegistration -> Maybe FontSize
accordionRegistrationFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , AccordionRegistration -> Maybe FontWeight
accordionRegistrationFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , AccordionRegistration -> Maybe Color
accordionRegistrationColor :: (Maybe Color) -- ^ /color/ attribute
        , AccordionRegistration -> Maybe LeftCenterRight
accordionRegistrationHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , AccordionRegistration -> Maybe Valign
accordionRegistrationValign :: (Maybe Valign) -- ^ /valign/ attribute
        , AccordionRegistration -> Maybe ID
accordionRegistrationId :: (Maybe ID) -- ^ /id/ attribute
        , AccordionRegistration -> Maybe Empty
accordionRegistrationAccordionHigh :: (Maybe Empty) -- ^ /accordion-high/ child element
        , AccordionRegistration -> Maybe AccordionMiddle
accordionRegistrationAccordionMiddle :: (Maybe AccordionMiddle) -- ^ /accordion-middle/ child element
        , AccordionRegistration -> Maybe Empty
accordionRegistrationAccordionLow :: (Maybe Empty) -- ^ /accordion-low/ child element
       }
    deriving (AccordionRegistration -> AccordionRegistration -> Bool
(AccordionRegistration -> AccordionRegistration -> Bool)
-> (AccordionRegistration -> AccordionRegistration -> Bool)
-> Eq AccordionRegistration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccordionRegistration -> AccordionRegistration -> Bool
$c/= :: AccordionRegistration -> AccordionRegistration -> Bool
== :: AccordionRegistration -> AccordionRegistration -> Bool
$c== :: AccordionRegistration -> AccordionRegistration -> Bool
Eq,Typeable,(forall x. AccordionRegistration -> Rep AccordionRegistration x)
-> (forall x. Rep AccordionRegistration x -> AccordionRegistration)
-> Generic AccordionRegistration
forall x. Rep AccordionRegistration x -> AccordionRegistration
forall x. AccordionRegistration -> Rep AccordionRegistration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccordionRegistration x -> AccordionRegistration
$cfrom :: forall x. AccordionRegistration -> Rep AccordionRegistration x
Generic,Int -> AccordionRegistration -> ShowS
[AccordionRegistration] -> ShowS
AccordionRegistration -> String
(Int -> AccordionRegistration -> ShowS)
-> (AccordionRegistration -> String)
-> ([AccordionRegistration] -> ShowS)
-> Show AccordionRegistration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccordionRegistration] -> ShowS
$cshowList :: [AccordionRegistration] -> ShowS
show :: AccordionRegistration -> String
$cshow :: AccordionRegistration -> String
showsPrec :: Int -> AccordionRegistration -> ShowS
$cshowsPrec :: Int -> AccordionRegistration -> ShowS
Show)
instance EmitXml AccordionRegistration where
    emitXml :: AccordionRegistration -> XmlRep
emitXml (AccordionRegistration Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe LeftCenterRight
j Maybe Valign
k Maybe ID
l Maybe Empty
m Maybe AccordionMiddle
n Maybe Empty
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        ([XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accordion-high" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (AccordionMiddle -> XmlRep) -> Maybe AccordionMiddle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accordion-middle" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AccordionMiddle -> XmlRep) -> AccordionMiddle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AccordionMiddle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AccordionMiddle
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accordion-low" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
o])
parseAccordionRegistration :: P.XParse AccordionRegistration
parseAccordionRegistration :: XParse AccordionRegistration
parseAccordionRegistration = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Maybe Empty
-> Maybe AccordionMiddle
-> Maybe Empty
-> AccordionRegistration
AccordionRegistration
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> Maybe Empty
 -> Maybe AccordionMiddle
 -> Maybe Empty
 -> AccordionRegistration)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe Valign)
-> XParse
     (Maybe ID
      -> Maybe Empty
      -> Maybe AccordionMiddle
      -> Maybe Empty
      -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe ID
   -> Maybe Empty
   -> Maybe AccordionMiddle
   -> Maybe Empty
   -> AccordionRegistration)
-> XParse (Maybe ID)
-> XParse
     (Maybe Empty
      -> Maybe AccordionMiddle -> Maybe Empty -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Maybe Empty
   -> Maybe AccordionMiddle -> Maybe Empty -> AccordionRegistration)
-> XParse (Maybe Empty)
-> XParse
     (Maybe AccordionMiddle -> Maybe Empty -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accordion-high") (XParse Empty
parseEmpty))
        XParse
  (Maybe AccordionMiddle -> Maybe Empty -> AccordionRegistration)
-> XParse (Maybe AccordionMiddle)
-> XParse (Maybe Empty -> AccordionRegistration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AccordionMiddle -> XParse (Maybe AccordionMiddle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse AccordionMiddle -> XParse AccordionMiddle
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accordion-middle") (XParse String
P.xtext XParse String
-> (String -> XParse AccordionMiddle) -> XParse AccordionMiddle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AccordionMiddle
parseAccordionMiddle))
        XParse (Maybe Empty -> AccordionRegistration)
-> XParse (Maybe Empty) -> XParse AccordionRegistration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accordion-low") (XParse Empty
parseEmpty))

-- | Smart constructor for 'AccordionRegistration'
mkAccordionRegistration :: AccordionRegistration
mkAccordionRegistration :: AccordionRegistration
mkAccordionRegistration = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Maybe Empty
-> Maybe AccordionMiddle
-> Maybe Empty
-> AccordionRegistration
AccordionRegistration Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing Maybe AccordionMiddle
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing

-- | @appearance@ /(complex)/
--
-- The appearance type controls general graphical settings for the music's final form appearance on a printed page of display. This includes support for line widths, definitions for note sizes, and standard distances between notation elements, plus an extension element for other aspects of appearance.
data Appearance = 
      Appearance {
          Appearance -> [LineWidth]
appearanceLineWidth :: [LineWidth] -- ^ /line-width/ child element
        , Appearance -> [NoteSize]
appearanceNoteSize :: [NoteSize] -- ^ /note-size/ child element
        , Appearance -> [Distance]
appearanceDistance :: [Distance] -- ^ /distance/ child element
        , Appearance -> [Glyph]
appearanceGlyph :: [Glyph] -- ^ /glyph/ child element
        , Appearance -> [OtherAppearance]
appearanceOtherAppearance :: [OtherAppearance] -- ^ /other-appearance/ child element
       }
    deriving (Appearance -> Appearance -> Bool
(Appearance -> Appearance -> Bool)
-> (Appearance -> Appearance -> Bool) -> Eq Appearance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Appearance -> Appearance -> Bool
$c/= :: Appearance -> Appearance -> Bool
== :: Appearance -> Appearance -> Bool
$c== :: Appearance -> Appearance -> Bool
Eq,Typeable,(forall x. Appearance -> Rep Appearance x)
-> (forall x. Rep Appearance x -> Appearance) -> Generic Appearance
forall x. Rep Appearance x -> Appearance
forall x. Appearance -> Rep Appearance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Appearance x -> Appearance
$cfrom :: forall x. Appearance -> Rep Appearance x
Generic,Int -> Appearance -> ShowS
[Appearance] -> ShowS
Appearance -> String
(Int -> Appearance -> ShowS)
-> (Appearance -> String)
-> ([Appearance] -> ShowS)
-> Show Appearance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Appearance] -> ShowS
$cshowList :: [Appearance] -> ShowS
show :: Appearance -> String
$cshow :: Appearance -> String
showsPrec :: Int -> Appearance -> ShowS
$cshowsPrec :: Int -> Appearance -> ShowS
Show)
instance EmitXml Appearance where
    emitXml :: Appearance -> XmlRep
emitXml (Appearance [LineWidth]
a [NoteSize]
b [Distance]
c [Glyph]
d [OtherAppearance]
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((LineWidth -> XmlRep) -> [LineWidth] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"line-width" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineWidth -> XmlRep) -> LineWidth -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineWidth -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [LineWidth]
a [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (NoteSize -> XmlRep) -> [NoteSize] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"note-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NoteSize -> XmlRep) -> NoteSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NoteSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [NoteSize]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Distance -> XmlRep) -> [Distance] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"distance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Distance -> XmlRep) -> Distance -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Distance -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Distance]
c [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Glyph -> XmlRep) -> [Glyph] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"glyph" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Glyph -> XmlRep) -> Glyph -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Glyph -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Glyph]
d [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (OtherAppearance -> XmlRep) -> [OtherAppearance] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-appearance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (OtherAppearance -> XmlRep) -> OtherAppearance -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.OtherAppearance -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [OtherAppearance]
e)
parseAppearance :: P.XParse Appearance
parseAppearance :: XParse Appearance
parseAppearance = 
      [LineWidth]
-> [NoteSize]
-> [Distance]
-> [Glyph]
-> [OtherAppearance]
-> Appearance
Appearance
        ([LineWidth]
 -> [NoteSize]
 -> [Distance]
 -> [Glyph]
 -> [OtherAppearance]
 -> Appearance)
-> XParse [LineWidth]
-> XParse
     ([NoteSize]
      -> [Distance] -> [Glyph] -> [OtherAppearance] -> Appearance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse LineWidth -> XParse [LineWidth]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse LineWidth -> XParse LineWidth
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"line-width") (XParse LineWidth
parseLineWidth))
        XParse
  ([NoteSize]
   -> [Distance] -> [Glyph] -> [OtherAppearance] -> Appearance)
-> XParse [NoteSize]
-> XParse
     ([Distance] -> [Glyph] -> [OtherAppearance] -> Appearance)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NoteSize -> XParse [NoteSize]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse NoteSize -> XParse NoteSize
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"note-size") (XParse NoteSize
parseNoteSize))
        XParse ([Distance] -> [Glyph] -> [OtherAppearance] -> Appearance)
-> XParse [Distance]
-> XParse ([Glyph] -> [OtherAppearance] -> Appearance)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Distance -> XParse [Distance]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Distance -> XParse Distance
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"distance") (XParse Distance
parseDistance))
        XParse ([Glyph] -> [OtherAppearance] -> Appearance)
-> XParse [Glyph] -> XParse ([OtherAppearance] -> Appearance)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Glyph -> XParse [Glyph]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Glyph -> XParse Glyph
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"glyph") (XParse Glyph
parseGlyph))
        XParse ([OtherAppearance] -> Appearance)
-> XParse [OtherAppearance] -> XParse Appearance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse OtherAppearance -> XParse [OtherAppearance]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse OtherAppearance -> XParse OtherAppearance
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-appearance") (XParse OtherAppearance
parseOtherAppearance))

-- | Smart constructor for 'Appearance'
mkAppearance :: Appearance
mkAppearance :: Appearance
mkAppearance = [LineWidth]
-> [NoteSize]
-> [Distance]
-> [Glyph]
-> [OtherAppearance]
-> Appearance
Appearance [] [] [] [] []

-- | @arpeggiate@ /(complex)/
--
-- The arpeggiate type indicates that this note is part of an arpeggiated chord. The number attribute can be used to distinguish between two simultaneous chords arpeggiated separately (different numbers) or together (same number). The up-down attribute is used if there is an arrow on the arpeggio sign. By default, arpeggios go from the lowest to highest note.
data Arpeggiate = 
      Arpeggiate {
          Arpeggiate -> Maybe NumberLevel
arpeggiateNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Arpeggiate -> Maybe UpDown
arpeggiateDirection :: (Maybe UpDown) -- ^ /direction/ attribute
        , Arpeggiate -> Maybe Tenths
arpeggiateDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Arpeggiate -> Maybe Tenths
arpeggiateDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Arpeggiate -> Maybe Tenths
arpeggiateRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Arpeggiate -> Maybe Tenths
arpeggiateRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Arpeggiate -> Maybe AboveBelow
arpeggiatePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Arpeggiate -> Maybe Color
arpeggiateColor :: (Maybe Color) -- ^ /color/ attribute
        , Arpeggiate -> Maybe ID
arpeggiateId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Arpeggiate -> Arpeggiate -> Bool
(Arpeggiate -> Arpeggiate -> Bool)
-> (Arpeggiate -> Arpeggiate -> Bool) -> Eq Arpeggiate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arpeggiate -> Arpeggiate -> Bool
$c/= :: Arpeggiate -> Arpeggiate -> Bool
== :: Arpeggiate -> Arpeggiate -> Bool
$c== :: Arpeggiate -> Arpeggiate -> Bool
Eq,Typeable,(forall x. Arpeggiate -> Rep Arpeggiate x)
-> (forall x. Rep Arpeggiate x -> Arpeggiate) -> Generic Arpeggiate
forall x. Rep Arpeggiate x -> Arpeggiate
forall x. Arpeggiate -> Rep Arpeggiate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Arpeggiate x -> Arpeggiate
$cfrom :: forall x. Arpeggiate -> Rep Arpeggiate x
Generic,Int -> Arpeggiate -> ShowS
[Arpeggiate] -> ShowS
Arpeggiate -> String
(Int -> Arpeggiate -> ShowS)
-> (Arpeggiate -> String)
-> ([Arpeggiate] -> ShowS)
-> Show Arpeggiate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arpeggiate] -> ShowS
$cshowList :: [Arpeggiate] -> ShowS
show :: Arpeggiate -> String
$cshow :: Arpeggiate -> String
showsPrec :: Int -> Arpeggiate -> ShowS
$cshowsPrec :: Int -> Arpeggiate -> ShowS
Show)
instance EmitXml Arpeggiate where
    emitXml :: Arpeggiate -> XmlRep
emitXml (Arpeggiate Maybe NumberLevel
a Maybe UpDown
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe AboveBelow
g Maybe Color
h Maybe ID
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (UpDown -> XmlRep) -> Maybe UpDown -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"direction" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (UpDown -> XmlRep) -> UpDown -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UpDown -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe UpDown
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
i])
        []
parseArpeggiate :: P.XParse Arpeggiate
parseArpeggiate :: XParse Arpeggiate
parseArpeggiate = 
      Maybe NumberLevel
-> Maybe UpDown
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe ID
-> Arpeggiate
Arpeggiate
        (Maybe NumberLevel
 -> Maybe UpDown
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe Color
 -> Maybe ID
 -> Arpeggiate)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe UpDown
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> Arpeggiate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe UpDown
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> Arpeggiate)
-> XParse (Maybe UpDown)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse UpDown -> XParse (Maybe UpDown)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"direction") XParse String -> (String -> XParse UpDown) -> XParse UpDown
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse UpDown
parseUpDown)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> Arpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> Arpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> Arpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow -> Maybe Color -> Maybe ID -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow -> Maybe Color -> Maybe ID -> Arpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow -> Maybe Color -> Maybe ID -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe AboveBelow -> Maybe Color -> Maybe ID -> Arpeggiate)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe Color -> Maybe ID -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe Color -> Maybe ID -> Arpeggiate)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Arpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Arpeggiate)
-> XParse (Maybe ID) -> XParse Arpeggiate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Arpeggiate'
mkArpeggiate :: Arpeggiate
mkArpeggiate :: Arpeggiate
mkArpeggiate = Maybe NumberLevel
-> Maybe UpDown
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe ID
-> Arpeggiate
Arpeggiate Maybe NumberLevel
forall a. Maybe a
Nothing Maybe UpDown
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @arrow@ /(complex)/
--
-- The arrow element represents an arrow used for a musical technical indication. It can represent both Unicode and SMuFL arrows. The presence of an arrowhead element indicates that only the arrowhead is displayed, not the arrow stem. The smufl attribute distinguishes different SMuFL glyphs that have an arrow appearance such as arrowBlackUp, guitarStrumUp, or handbellsSwingUp. The specified glyph should match the descriptive representation.
data Arrow = 
      Arrow {
          Arrow -> Maybe Tenths
arrowDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Arrow -> Maybe Tenths
arrowDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Arrow -> Maybe Tenths
arrowRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Arrow -> Maybe Tenths
arrowRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Arrow -> Maybe CommaSeparatedText
arrowFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Arrow -> Maybe FontStyle
arrowFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Arrow -> Maybe FontSize
arrowFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Arrow -> Maybe FontWeight
arrowFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Arrow -> Maybe Color
arrowColor :: (Maybe Color) -- ^ /color/ attribute
        , Arrow -> Maybe AboveBelow
arrowPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Arrow -> Maybe SmuflGlyphName
arrowSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
        , Arrow -> ChxArrow
arrowArrow :: ChxArrow
       }
    deriving (Arrow -> Arrow -> Bool
(Arrow -> Arrow -> Bool) -> (Arrow -> Arrow -> Bool) -> Eq Arrow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arrow -> Arrow -> Bool
$c/= :: Arrow -> Arrow -> Bool
== :: Arrow -> Arrow -> Bool
$c== :: Arrow -> Arrow -> Bool
Eq,Typeable,(forall x. Arrow -> Rep Arrow x)
-> (forall x. Rep Arrow x -> Arrow) -> Generic Arrow
forall x. Rep Arrow x -> Arrow
forall x. Arrow -> Rep Arrow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Arrow x -> Arrow
$cfrom :: forall x. Arrow -> Rep Arrow x
Generic,Int -> Arrow -> ShowS
[Arrow] -> ShowS
Arrow -> String
(Int -> Arrow -> ShowS)
-> (Arrow -> String) -> ([Arrow] -> ShowS) -> Show Arrow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arrow] -> ShowS
$cshowList :: [Arrow] -> ShowS
show :: Arrow -> String
$cshow :: Arrow -> String
showsPrec :: Int -> Arrow -> ShowS
$cshowsPrec :: Int -> Arrow -> ShowS
Show)
instance EmitXml Arrow where
    emitXml :: Arrow -> XmlRep
emitXml (Arrow Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j Maybe SmuflGlyphName
k ChxArrow
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
k])
        ([ChxArrow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxArrow
l])
parseArrow :: P.XParse Arrow
parseArrow :: XParse Arrow
parseArrow = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> ChxArrow
-> Arrow
Arrow
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe SmuflGlyphName
 -> ChxArrow
 -> Arrow)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> ChxArrow
      -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> ChxArrow
   -> Arrow)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow -> Maybe SmuflGlyphName -> ChxArrow -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow -> Maybe SmuflGlyphName -> ChxArrow -> Arrow)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow -> Maybe SmuflGlyphName -> ChxArrow -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow -> Maybe SmuflGlyphName -> ChxArrow -> Arrow)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe SmuflGlyphName -> ChxArrow -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe SmuflGlyphName -> ChxArrow -> Arrow)
-> XParse (Maybe SmuflGlyphName) -> XParse (ChxArrow -> Arrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)
        XParse (ChxArrow -> Arrow) -> XParse ChxArrow -> XParse Arrow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxArrow
parseChxArrow

-- | Smart constructor for 'Arrow'
mkArrow :: ChxArrow -> Arrow
mkArrow :: ChxArrow -> Arrow
mkArrow ChxArrow
l = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> ChxArrow
-> Arrow
Arrow Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing ChxArrow
l

-- | @articulations@ /(complex)/
--
-- Articulations and accents are grouped together here.
data Articulations = 
      Articulations {
          Articulations -> Maybe ID
articulationsId :: (Maybe ID) -- ^ /id/ attribute
        , Articulations -> [ChxArticulations]
articulationsArticulations :: [ChxArticulations]
       }
    deriving (Articulations -> Articulations -> Bool
(Articulations -> Articulations -> Bool)
-> (Articulations -> Articulations -> Bool) -> Eq Articulations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Articulations -> Articulations -> Bool
$c/= :: Articulations -> Articulations -> Bool
== :: Articulations -> Articulations -> Bool
$c== :: Articulations -> Articulations -> Bool
Eq,Typeable,(forall x. Articulations -> Rep Articulations x)
-> (forall x. Rep Articulations x -> Articulations)
-> Generic Articulations
forall x. Rep Articulations x -> Articulations
forall x. Articulations -> Rep Articulations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Articulations x -> Articulations
$cfrom :: forall x. Articulations -> Rep Articulations x
Generic,Int -> Articulations -> ShowS
[Articulations] -> ShowS
Articulations -> String
(Int -> Articulations -> ShowS)
-> (Articulations -> String)
-> ([Articulations] -> ShowS)
-> Show Articulations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Articulations] -> ShowS
$cshowList :: [Articulations] -> ShowS
show :: Articulations -> String
$cshow :: Articulations -> String
showsPrec :: Int -> Articulations -> ShowS
$cshowsPrec :: Int -> Articulations -> ShowS
Show)
instance EmitXml Articulations where
    emitXml :: Articulations -> XmlRep
emitXml (Articulations Maybe ID
a [ChxArticulations]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
a])
        ([[ChxArticulations] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxArticulations]
b])
parseArticulations :: P.XParse Articulations
parseArticulations :: XParse Articulations
parseArticulations = 
      Maybe ID -> [ChxArticulations] -> Articulations
Articulations
        (Maybe ID -> [ChxArticulations] -> Articulations)
-> XParse (Maybe ID)
-> XParse ([ChxArticulations] -> Articulations)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([ChxArticulations] -> Articulations)
-> XParse [ChxArticulations] -> XParse Articulations
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxArticulations -> XParse [ChxArticulations]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxArticulations
parseChxArticulations)

-- | Smart constructor for 'Articulations'
mkArticulations :: Articulations
mkArticulations :: Articulations
mkArticulations = Maybe ID -> [ChxArticulations] -> Articulations
Articulations Maybe ID
forall a. Maybe a
Nothing []

-- | @attributes@ /(complex)/
--
-- The attributes element contains musical information that typically changes on measure boundaries. This includes key and time signatures, clefs, transpositions, and staving. When attributes are changed mid-measure, it affects the music in score order, not in MusicXML document order.
data Attributes = 
      Attributes {
          Attributes -> Editorial
attributesEditorial :: Editorial
        , Attributes -> Maybe PositiveDivisions
attributesDivisions :: (Maybe PositiveDivisions) -- ^ /divisions/ child element
        , Attributes -> [Key]
attributesKey :: [Key] -- ^ /key/ child element
        , Attributes -> [Time]
attributesTime :: [Time] -- ^ /time/ child element
        , Attributes -> Maybe NonNegativeInteger
attributesStaves :: (Maybe NonNegativeInteger) -- ^ /staves/ child element
        , Attributes -> Maybe PartSymbol
attributesPartSymbol :: (Maybe PartSymbol) -- ^ /part-symbol/ child element
        , Attributes -> Maybe NonNegativeInteger
attributesInstruments :: (Maybe NonNegativeInteger) -- ^ /instruments/ child element
        , Attributes -> [Clef]
attributesClef :: [Clef] -- ^ /clef/ child element
        , Attributes -> [StaffDetails]
attributesStaffDetails :: [StaffDetails] -- ^ /staff-details/ child element
        , Attributes -> [Transpose]
attributesTranspose :: [Transpose] -- ^ /transpose/ child element
        , Attributes -> [Directive]
attributesDirective :: [Directive] -- ^ /directive/ child element
        , Attributes -> [MeasureStyle]
attributesMeasureStyle :: [MeasureStyle] -- ^ /measure-style/ child element
       }
    deriving (Attributes -> Attributes -> Bool
(Attributes -> Attributes -> Bool)
-> (Attributes -> Attributes -> Bool) -> Eq Attributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq,Typeable,(forall x. Attributes -> Rep Attributes x)
-> (forall x. Rep Attributes x -> Attributes) -> Generic Attributes
forall x. Rep Attributes x -> Attributes
forall x. Attributes -> Rep Attributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attributes x -> Attributes
$cfrom :: forall x. Attributes -> Rep Attributes x
Generic,Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
(Int -> Attributes -> ShowS)
-> (Attributes -> String)
-> ([Attributes] -> ShowS)
-> Show Attributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show)
instance EmitXml Attributes where
    emitXml :: Attributes -> XmlRep
emitXml (Attributes Editorial
a Maybe PositiveDivisions
b [Key]
c [Time]
d Maybe NonNegativeInteger
e Maybe PartSymbol
f Maybe NonNegativeInteger
g [Clef]
h [StaffDetails]
i [Transpose]
j [Directive]
k [MeasureStyle]
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveDivisions -> XmlRep)
-> Maybe PositiveDivisions
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"divisions" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveDivisions -> XmlRep) -> PositiveDivisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveDivisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveDivisions
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Key -> XmlRep) -> [Key] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"key" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Key -> XmlRep) -> Key -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Key -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Key]
c [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Time -> XmlRep) -> [Time] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"time" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Time -> XmlRep) -> Time -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Time -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Time]
d [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeInteger -> XmlRep)
-> Maybe NonNegativeInteger
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staves" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeInteger -> XmlRep) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeInteger
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (PartSymbol -> XmlRep) -> Maybe PartSymbol -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-symbol" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PartSymbol -> XmlRep) -> PartSymbol -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PartSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PartSymbol
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeInteger -> XmlRep)
-> Maybe NonNegativeInteger
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"instruments" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeInteger -> XmlRep) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeInteger
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Clef -> XmlRep) -> [Clef] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"clef" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Clef -> XmlRep) -> Clef -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Clef -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Clef]
h [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (StaffDetails -> XmlRep) -> [StaffDetails] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-details" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffDetails -> XmlRep) -> StaffDetails -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffDetails -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [StaffDetails]
i [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Transpose -> XmlRep) -> [Transpose] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"transpose" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Transpose -> XmlRep) -> Transpose -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transpose -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Transpose]
j [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Directive -> XmlRep) -> [Directive] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"directive" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Directive -> XmlRep) -> Directive -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Directive -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Directive]
k [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (MeasureStyle -> XmlRep) -> [MeasureStyle] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MeasureStyle -> XmlRep) -> MeasureStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MeasureStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [MeasureStyle]
l)
parseAttributes :: P.XParse Attributes
parseAttributes :: XParse Attributes
parseAttributes = 
      Editorial
-> Maybe PositiveDivisions
-> [Key]
-> [Time]
-> Maybe NonNegativeInteger
-> Maybe PartSymbol
-> Maybe NonNegativeInteger
-> [Clef]
-> [StaffDetails]
-> [Transpose]
-> [Directive]
-> [MeasureStyle]
-> Attributes
Attributes
        (Editorial
 -> Maybe PositiveDivisions
 -> [Key]
 -> [Time]
 -> Maybe NonNegativeInteger
 -> Maybe PartSymbol
 -> Maybe NonNegativeInteger
 -> [Clef]
 -> [StaffDetails]
 -> [Transpose]
 -> [Directive]
 -> [MeasureStyle]
 -> Attributes)
-> XParse Editorial
-> XParse
     (Maybe PositiveDivisions
      -> [Key]
      -> [Time]
      -> Maybe NonNegativeInteger
      -> Maybe PartSymbol
      -> Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Editorial
parseEditorial
        XParse
  (Maybe PositiveDivisions
   -> [Key]
   -> [Time]
   -> Maybe NonNegativeInteger
   -> Maybe PartSymbol
   -> Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse (Maybe PositiveDivisions)
-> XParse
     ([Key]
      -> [Time]
      -> Maybe NonNegativeInteger
      -> Maybe PartSymbol
      -> Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveDivisions -> XParse (Maybe PositiveDivisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse PositiveDivisions -> XParse PositiveDivisions
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"divisions") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveDivisions) -> XParse PositiveDivisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveDivisions
parsePositiveDivisions))
        XParse
  ([Key]
   -> [Time]
   -> Maybe NonNegativeInteger
   -> Maybe PartSymbol
   -> Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse [Key]
-> XParse
     ([Time]
      -> Maybe NonNegativeInteger
      -> Maybe PartSymbol
      -> Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Key -> XParse [Key]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Key -> XParse Key
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"key") (XParse Key
parseKey))
        XParse
  ([Time]
   -> Maybe NonNegativeInteger
   -> Maybe PartSymbol
   -> Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse [Time]
-> XParse
     (Maybe NonNegativeInteger
      -> Maybe PartSymbol
      -> Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Time -> XParse [Time]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Time -> XParse Time
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"time") (XParse Time
parseTime))
        XParse
  (Maybe NonNegativeInteger
   -> Maybe PartSymbol
   -> Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse (Maybe NonNegativeInteger)
-> XParse
     (Maybe PartSymbol
      -> Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeInteger -> XParse (Maybe NonNegativeInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staves") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse
  (Maybe PartSymbol
   -> Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse (Maybe PartSymbol)
-> XParse
     (Maybe NonNegativeInteger
      -> [Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PartSymbol -> XParse (Maybe PartSymbol)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse PartSymbol -> XParse PartSymbol
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-symbol") (XParse PartSymbol
parsePartSymbol))
        XParse
  (Maybe NonNegativeInteger
   -> [Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse (Maybe NonNegativeInteger)
-> XParse
     ([Clef]
      -> [StaffDetails]
      -> [Transpose]
      -> [Directive]
      -> [MeasureStyle]
      -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeInteger -> XParse (Maybe NonNegativeInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"instruments") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse
  ([Clef]
   -> [StaffDetails]
   -> [Transpose]
   -> [Directive]
   -> [MeasureStyle]
   -> Attributes)
-> XParse [Clef]
-> XParse
     ([StaffDetails]
      -> [Transpose] -> [Directive] -> [MeasureStyle] -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Clef -> XParse [Clef]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Clef -> XParse Clef
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"clef") (XParse Clef
parseClef))
        XParse
  ([StaffDetails]
   -> [Transpose] -> [Directive] -> [MeasureStyle] -> Attributes)
-> XParse [StaffDetails]
-> XParse
     ([Transpose] -> [Directive] -> [MeasureStyle] -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffDetails -> XParse [StaffDetails]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse StaffDetails -> XParse StaffDetails
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-details") (XParse StaffDetails
parseStaffDetails))
        XParse ([Transpose] -> [Directive] -> [MeasureStyle] -> Attributes)
-> XParse [Transpose]
-> XParse ([Directive] -> [MeasureStyle] -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Transpose -> XParse [Transpose]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Transpose -> XParse Transpose
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"transpose") (XParse Transpose
parseTranspose))
        XParse ([Directive] -> [MeasureStyle] -> Attributes)
-> XParse [Directive] -> XParse ([MeasureStyle] -> Attributes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Directive -> XParse [Directive]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Directive -> XParse Directive
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"directive") (XParse Directive
parseDirective))
        XParse ([MeasureStyle] -> Attributes)
-> XParse [MeasureStyle] -> XParse Attributes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MeasureStyle -> XParse [MeasureStyle]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse MeasureStyle -> XParse MeasureStyle
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure-style") (XParse MeasureStyle
parseMeasureStyle))

-- | Smart constructor for 'Attributes'
mkAttributes :: Editorial -> Attributes
mkAttributes :: Editorial -> Attributes
mkAttributes Editorial
a = Editorial
-> Maybe PositiveDivisions
-> [Key]
-> [Time]
-> Maybe NonNegativeInteger
-> Maybe PartSymbol
-> Maybe NonNegativeInteger
-> [Clef]
-> [StaffDetails]
-> [Transpose]
-> [Directive]
-> [MeasureStyle]
-> Attributes
Attributes Editorial
a Maybe PositiveDivisions
forall a. Maybe a
Nothing [] [] Maybe NonNegativeInteger
forall a. Maybe a
Nothing Maybe PartSymbol
forall a. Maybe a
Nothing Maybe NonNegativeInteger
forall a. Maybe a
Nothing [] [] [] [] []

-- | @backup@ /(complex)/
--
-- The backup and forward elements are required to coordinate multiple voices in one part, including music on multiple staves. The backup type is generally used to move between voices and staves. Thus the backup element does not include voice or staff elements. Duration values should always be positive, and should not cross measure boundaries or mid-measure changes in the divisions value.
data Backup = 
      Backup {
          Backup -> Duration
backupDuration :: Duration
        , Backup -> Editorial
backupEditorial :: Editorial
       }
    deriving (Backup -> Backup -> Bool
(Backup -> Backup -> Bool)
-> (Backup -> Backup -> Bool) -> Eq Backup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Backup -> Backup -> Bool
$c/= :: Backup -> Backup -> Bool
== :: Backup -> Backup -> Bool
$c== :: Backup -> Backup -> Bool
Eq,Typeable,(forall x. Backup -> Rep Backup x)
-> (forall x. Rep Backup x -> Backup) -> Generic Backup
forall x. Rep Backup x -> Backup
forall x. Backup -> Rep Backup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Backup x -> Backup
$cfrom :: forall x. Backup -> Rep Backup x
Generic,Int -> Backup -> ShowS
[Backup] -> ShowS
Backup -> String
(Int -> Backup -> ShowS)
-> (Backup -> String) -> ([Backup] -> ShowS) -> Show Backup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Backup] -> ShowS
$cshowList :: [Backup] -> ShowS
show :: Backup -> String
$cshow :: Backup -> String
showsPrec :: Int -> Backup -> ShowS
$cshowsPrec :: Int -> Backup -> ShowS
Show)
instance EmitXml Backup where
    emitXml :: Backup -> XmlRep
emitXml (Backup Duration
a Editorial
b) =
      [XmlRep] -> XmlRep
XReps [Duration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Duration
a,Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
b]
parseBackup :: P.XParse Backup
parseBackup :: XParse Backup
parseBackup = 
      Duration -> Editorial -> Backup
Backup
        (Duration -> Editorial -> Backup)
-> XParse Duration -> XParse (Editorial -> Backup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Duration
parseDuration
        XParse (Editorial -> Backup) -> XParse Editorial -> XParse Backup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial

-- | Smart constructor for 'Backup'
mkBackup :: Duration -> Editorial -> Backup
mkBackup :: Duration -> Editorial -> Backup
mkBackup Duration
a Editorial
b = Duration -> Editorial -> Backup
Backup Duration
a Editorial
b

-- | @bar-style-color@ /(complex)/
--
-- The bar-style-color type contains barline style and color information.
data BarStyleColor = 
      BarStyleColor {
          BarStyleColor -> BarStyle
barStyleColorBarStyle :: BarStyle -- ^ text content
        , BarStyleColor -> Maybe Color
barStyleColorColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (BarStyleColor -> BarStyleColor -> Bool
(BarStyleColor -> BarStyleColor -> Bool)
-> (BarStyleColor -> BarStyleColor -> Bool) -> Eq BarStyleColor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarStyleColor -> BarStyleColor -> Bool
$c/= :: BarStyleColor -> BarStyleColor -> Bool
== :: BarStyleColor -> BarStyleColor -> Bool
$c== :: BarStyleColor -> BarStyleColor -> Bool
Eq,Typeable,(forall x. BarStyleColor -> Rep BarStyleColor x)
-> (forall x. Rep BarStyleColor x -> BarStyleColor)
-> Generic BarStyleColor
forall x. Rep BarStyleColor x -> BarStyleColor
forall x. BarStyleColor -> Rep BarStyleColor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BarStyleColor x -> BarStyleColor
$cfrom :: forall x. BarStyleColor -> Rep BarStyleColor x
Generic,Int -> BarStyleColor -> ShowS
[BarStyleColor] -> ShowS
BarStyleColor -> String
(Int -> BarStyleColor -> ShowS)
-> (BarStyleColor -> String)
-> ([BarStyleColor] -> ShowS)
-> Show BarStyleColor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarStyleColor] -> ShowS
$cshowList :: [BarStyleColor] -> ShowS
show :: BarStyleColor -> String
$cshow :: BarStyleColor -> String
showsPrec :: Int -> BarStyleColor -> ShowS
$cshowsPrec :: Int -> BarStyleColor -> ShowS
Show)
instance EmitXml BarStyleColor where
    emitXml :: BarStyleColor -> XmlRep
emitXml (BarStyleColor BarStyle
a Maybe Color
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (BarStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BarStyle
a)
        ([XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
b])
        []
parseBarStyleColor :: P.XParse BarStyleColor
parseBarStyleColor :: XParse BarStyleColor
parseBarStyleColor = 
      BarStyle -> Maybe Color -> BarStyleColor
BarStyleColor
        (BarStyle -> Maybe Color -> BarStyleColor)
-> XParse BarStyle -> XParse (Maybe Color -> BarStyleColor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse BarStyle) -> XParse BarStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BarStyle
parseBarStyle)
        XParse (Maybe Color -> BarStyleColor)
-> XParse (Maybe Color) -> XParse BarStyleColor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'BarStyleColor'
mkBarStyleColor :: BarStyle -> BarStyleColor
mkBarStyleColor :: BarStyle -> BarStyleColor
mkBarStyleColor BarStyle
a = BarStyle -> Maybe Color -> BarStyleColor
BarStyleColor BarStyle
a Maybe Color
forall a. Maybe a
Nothing

-- | @barline@ /(complex)/
--
-- If a barline is other than a normal single barline, it should be represented by a barline type that describes it. This includes information about repeats and multiple endings, as well as line style. Barline data is on the same level as the other musical data in a score - a child of a measure in a partwise score, or a part in a timewise score. This allows for barlines within measures, as in dotted barlines that subdivide measures in complex meters. The two fermata elements allow for fermatas on both sides of the barline (the lower one inverted).
-- 
-- Barlines have a location attribute to make it easier to process barlines independently of the other musical data in a score. It is often easier to set up measures separately from entering notes. The location attribute must match where the barline element occurs within the rest of the musical data in the score. If location is left, it should be the first element in the measure, aside from the print, bookmark, and link elements. If location is right, it should be the last element, again with the possible exception of the print, bookmark, and link elements. If no location is specified, the right barline is the default. The segno, coda, and divisions attributes work the same way as in the sound element. They are used for playback when barline elements contain segno or coda child elements.
data Barline = 
      Barline {
          Barline -> Maybe RightLeftMiddle
barlineLocation :: (Maybe RightLeftMiddle) -- ^ /location/ attribute
        , Barline -> Maybe Token
barlineSegno :: (Maybe Token) -- ^ /segno/ attribute
        , Barline -> Maybe Token
barlineCoda :: (Maybe Token) -- ^ /coda/ attribute
        , Barline -> Maybe Divisions
barlineDivisions :: (Maybe Divisions) -- ^ /divisions/ attribute
        , Barline -> Maybe ID
barlineId :: (Maybe ID) -- ^ /id/ attribute
        , Barline -> Maybe BarStyleColor
barlineBarStyle :: (Maybe BarStyleColor) -- ^ /bar-style/ child element
        , Barline -> Editorial
barlineEditorial :: Editorial
        , Barline -> Maybe WavyLine
barlineWavyLine :: (Maybe WavyLine) -- ^ /wavy-line/ child element
        , Barline -> Maybe Segno
barlineSegno1 :: (Maybe Segno) -- ^ /segno/ child element
        , Barline -> Maybe Coda
barlineCoda1 :: (Maybe Coda) -- ^ /coda/ child element
        , Barline -> [Fermata]
barlineFermata :: [Fermata] -- ^ /fermata/ child element
        , Barline -> Maybe Ending
barlineEnding :: (Maybe Ending) -- ^ /ending/ child element
        , Barline -> Maybe Repeat
barlineRepeat :: (Maybe Repeat) -- ^ /repeat/ child element
       }
    deriving (Barline -> Barline -> Bool
(Barline -> Barline -> Bool)
-> (Barline -> Barline -> Bool) -> Eq Barline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Barline -> Barline -> Bool
$c/= :: Barline -> Barline -> Bool
== :: Barline -> Barline -> Bool
$c== :: Barline -> Barline -> Bool
Eq,Typeable,(forall x. Barline -> Rep Barline x)
-> (forall x. Rep Barline x -> Barline) -> Generic Barline
forall x. Rep Barline x -> Barline
forall x. Barline -> Rep Barline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Barline x -> Barline
$cfrom :: forall x. Barline -> Rep Barline x
Generic,Int -> Barline -> ShowS
[Barline] -> ShowS
Barline -> String
(Int -> Barline -> ShowS)
-> (Barline -> String) -> ([Barline] -> ShowS) -> Show Barline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Barline] -> ShowS
$cshowList :: [Barline] -> ShowS
show :: Barline -> String
$cshow :: Barline -> String
showsPrec :: Int -> Barline -> ShowS
$cshowsPrec :: Int -> Barline -> ShowS
Show)
instance EmitXml Barline where
    emitXml :: Barline -> XmlRep
emitXml (Barline Maybe RightLeftMiddle
a Maybe Token
b Maybe Token
c Maybe Divisions
d Maybe ID
e Maybe BarStyleColor
f Editorial
g Maybe WavyLine
h Maybe Segno
i Maybe Coda
j [Fermata]
k Maybe Ending
l Maybe Repeat
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (RightLeftMiddle -> XmlRep) -> Maybe RightLeftMiddle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RightLeftMiddle -> XmlRep) -> RightLeftMiddle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RightLeftMiddle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RightLeftMiddle
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"segno" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"coda" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"divisions" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
e])
        ([XmlRep
-> (BarStyleColor -> XmlRep) -> Maybe BarStyleColor -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bar-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (BarStyleColor -> XmlRep) -> BarStyleColor -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BarStyleColor -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe BarStyleColor
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (WavyLine -> XmlRep) -> Maybe WavyLine -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"wavy-line" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (WavyLine -> XmlRep) -> WavyLine -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.WavyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe WavyLine
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Segno -> XmlRep) -> Maybe Segno -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"segno" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Segno -> XmlRep) -> Segno -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Segno -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Segno
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Coda -> XmlRep) -> Maybe Coda -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"coda" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Coda -> XmlRep) -> Coda -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Coda -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Coda
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Fermata -> XmlRep) -> [Fermata] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fermata" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Fermata -> XmlRep) -> Fermata -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fermata -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Fermata]
k [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Ending -> XmlRep) -> Maybe Ending -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ending" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Ending -> XmlRep) -> Ending -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Ending -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Ending
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Repeat -> XmlRep) -> Maybe Repeat -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"repeat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Repeat -> XmlRep) -> Repeat -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Repeat -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Repeat
m])
parseBarline :: P.XParse Barline
parseBarline :: XParse Barline
parseBarline = 
      Maybe RightLeftMiddle
-> Maybe Token
-> Maybe Token
-> Maybe Divisions
-> Maybe ID
-> Maybe BarStyleColor
-> Editorial
-> Maybe WavyLine
-> Maybe Segno
-> Maybe Coda
-> [Fermata]
-> Maybe Ending
-> Maybe Repeat
-> Barline
Barline
        (Maybe RightLeftMiddle
 -> Maybe Token
 -> Maybe Token
 -> Maybe Divisions
 -> Maybe ID
 -> Maybe BarStyleColor
 -> Editorial
 -> Maybe WavyLine
 -> Maybe Segno
 -> Maybe Coda
 -> [Fermata]
 -> Maybe Ending
 -> Maybe Repeat
 -> Barline)
-> XParse (Maybe RightLeftMiddle)
-> XParse
     (Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe ID
      -> Maybe BarStyleColor
      -> Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse RightLeftMiddle -> XParse (Maybe RightLeftMiddle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String
-> (String -> XParse RightLeftMiddle) -> XParse RightLeftMiddle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RightLeftMiddle
parseRightLeftMiddle)
        XParse
  (Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe ID
   -> Maybe BarStyleColor
   -> Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe Token)
-> XParse
     (Maybe Token
      -> Maybe Divisions
      -> Maybe ID
      -> Maybe BarStyleColor
      -> Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"segno") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Token
   -> Maybe Divisions
   -> Maybe ID
   -> Maybe BarStyleColor
   -> Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe Token)
-> XParse
     (Maybe Divisions
      -> Maybe ID
      -> Maybe BarStyleColor
      -> Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"coda") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Divisions
   -> Maybe ID
   -> Maybe BarStyleColor
   -> Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe Divisions)
-> XParse
     (Maybe ID
      -> Maybe BarStyleColor
      -> Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"divisions") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse
  (Maybe ID
   -> Maybe BarStyleColor
   -> Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe ID)
-> XParse
     (Maybe BarStyleColor
      -> Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Maybe BarStyleColor
   -> Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe BarStyleColor)
-> XParse
     (Editorial
      -> Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BarStyleColor -> XParse (Maybe BarStyleColor)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse BarStyleColor -> XParse BarStyleColor
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bar-style") (XParse BarStyleColor
parseBarStyleColor))
        XParse
  (Editorial
   -> Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse Editorial
-> XParse
     (Maybe WavyLine
      -> Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial
        XParse
  (Maybe WavyLine
   -> Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe WavyLine)
-> XParse
     (Maybe Segno
      -> Maybe Coda
      -> [Fermata]
      -> Maybe Ending
      -> Maybe Repeat
      -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse WavyLine -> XParse (Maybe WavyLine)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse WavyLine -> XParse WavyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"wavy-line") (XParse WavyLine
parseWavyLine))
        XParse
  (Maybe Segno
   -> Maybe Coda
   -> [Fermata]
   -> Maybe Ending
   -> Maybe Repeat
   -> Barline)
-> XParse (Maybe Segno)
-> XParse
     (Maybe Coda
      -> [Fermata] -> Maybe Ending -> Maybe Repeat -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Segno -> XParse (Maybe Segno)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Segno -> XParse Segno
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"segno") (XParse Segno
parseSegno))
        XParse
  (Maybe Coda
   -> [Fermata] -> Maybe Ending -> Maybe Repeat -> Barline)
-> XParse (Maybe Coda)
-> XParse ([Fermata] -> Maybe Ending -> Maybe Repeat -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Coda -> XParse (Maybe Coda)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Coda -> XParse Coda
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"coda") (XParse Coda
parseCoda))
        XParse ([Fermata] -> Maybe Ending -> Maybe Repeat -> Barline)
-> XParse [Fermata]
-> XParse (Maybe Ending -> Maybe Repeat -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Fermata -> XParse [Fermata]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Fermata -> XParse Fermata
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fermata") (XParse Fermata
parseFermata))
        XParse (Maybe Ending -> Maybe Repeat -> Barline)
-> XParse (Maybe Ending) -> XParse (Maybe Repeat -> Barline)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Ending -> XParse (Maybe Ending)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Ending -> XParse Ending
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ending") (XParse Ending
parseEnding))
        XParse (Maybe Repeat -> Barline)
-> XParse (Maybe Repeat) -> XParse Barline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Repeat -> XParse (Maybe Repeat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Repeat -> XParse Repeat
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"repeat") (XParse Repeat
parseRepeat))

-- | Smart constructor for 'Barline'
mkBarline :: Editorial -> Barline
mkBarline :: Editorial -> Barline
mkBarline Editorial
g = Maybe RightLeftMiddle
-> Maybe Token
-> Maybe Token
-> Maybe Divisions
-> Maybe ID
-> Maybe BarStyleColor
-> Editorial
-> Maybe WavyLine
-> Maybe Segno
-> Maybe Coda
-> [Fermata]
-> Maybe Ending
-> Maybe Repeat
-> Barline
Barline Maybe RightLeftMiddle
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Maybe BarStyleColor
forall a. Maybe a
Nothing Editorial
g Maybe WavyLine
forall a. Maybe a
Nothing Maybe Segno
forall a. Maybe a
Nothing Maybe Coda
forall a. Maybe a
Nothing [] Maybe Ending
forall a. Maybe a
Nothing Maybe Repeat
forall a. Maybe a
Nothing

-- | @barre@ /(complex)/
--
-- The barre element indicates placing a finger over multiple strings on a single fret. The type is "start" for the lowest pitched string (e.g., the string with the highest MusicXML number) and is "stop" for the highest pitched string.
data Barre = 
      Barre {
          Barre -> StartStop
barreType :: StartStop -- ^ /type/ attribute
        , Barre -> Maybe Color
barreColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Barre -> Barre -> Bool
(Barre -> Barre -> Bool) -> (Barre -> Barre -> Bool) -> Eq Barre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Barre -> Barre -> Bool
$c/= :: Barre -> Barre -> Bool
== :: Barre -> Barre -> Bool
$c== :: Barre -> Barre -> Bool
Eq,Typeable,(forall x. Barre -> Rep Barre x)
-> (forall x. Rep Barre x -> Barre) -> Generic Barre
forall x. Rep Barre x -> Barre
forall x. Barre -> Rep Barre x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Barre x -> Barre
$cfrom :: forall x. Barre -> Rep Barre x
Generic,Int -> Barre -> ShowS
[Barre] -> ShowS
Barre -> String
(Int -> Barre -> ShowS)
-> (Barre -> String) -> ([Barre] -> ShowS) -> Show Barre
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Barre] -> ShowS
$cshowList :: [Barre] -> ShowS
show :: Barre -> String
$cshow :: Barre -> String
showsPrec :: Int -> Barre -> ShowS
$cshowsPrec :: Int -> Barre -> ShowS
Show)
instance EmitXml Barre where
    emitXml :: Barre -> XmlRep
emitXml (Barre StartStop
a Maybe Color
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
b])
        []
parseBarre :: P.XParse Barre
parseBarre :: XParse Barre
parseBarre = 
      StartStop -> Maybe Color -> Barre
Barre
        (StartStop -> Maybe Color -> Barre)
-> XParse StartStop -> XParse (Maybe Color -> Barre)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse (Maybe Color -> Barre)
-> XParse (Maybe Color) -> XParse Barre
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Barre'
mkBarre :: StartStop -> Barre
mkBarre :: StartStop -> Barre
mkBarre StartStop
a = StartStop -> Maybe Color -> Barre
Barre StartStop
a Maybe Color
forall a. Maybe a
Nothing

-- | @bass@ /(complex)/
--
-- The bass type is used to indicate a bass note in popular music chord symbols, e.g. G/C. It is generally not used in functional harmony, as inversion is generally not used in pop chord symbols. As with root, it is divided into step and alter elements, similar to pitches.
data Bass = 
      Bass {
          Bass -> BassStep
bassBassStep :: BassStep -- ^ /bass-step/ child element
        , Bass -> Maybe BassAlter
bassBassAlter :: (Maybe BassAlter) -- ^ /bass-alter/ child element
       }
    deriving (Bass -> Bass -> Bool
(Bass -> Bass -> Bool) -> (Bass -> Bass -> Bool) -> Eq Bass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bass -> Bass -> Bool
$c/= :: Bass -> Bass -> Bool
== :: Bass -> Bass -> Bool
$c== :: Bass -> Bass -> Bool
Eq,Typeable,(forall x. Bass -> Rep Bass x)
-> (forall x. Rep Bass x -> Bass) -> Generic Bass
forall x. Rep Bass x -> Bass
forall x. Bass -> Rep Bass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bass x -> Bass
$cfrom :: forall x. Bass -> Rep Bass x
Generic,Int -> Bass -> ShowS
[Bass] -> ShowS
Bass -> String
(Int -> Bass -> ShowS)
-> (Bass -> String) -> ([Bass] -> ShowS) -> Show Bass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bass] -> ShowS
$cshowList :: [Bass] -> ShowS
show :: Bass -> String
$cshow :: Bass -> String
showsPrec :: Int -> Bass -> ShowS
$cshowsPrec :: Int -> Bass -> ShowS
Show)
instance EmitXml Bass where
    emitXml :: Bass -> XmlRep
emitXml (Bass BassStep
a Maybe BassAlter
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bass-step" Maybe String
forall a. Maybe a
Nothing) (BassStep -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BassStep
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (BassAlter -> XmlRep) -> Maybe BassAlter -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bass-alter" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (BassAlter -> XmlRep) -> BassAlter -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BassAlter -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe BassAlter
b])
parseBass :: P.XParse Bass
parseBass :: XParse Bass
parseBass = 
      BassStep -> Maybe BassAlter -> Bass
Bass
        (BassStep -> Maybe BassAlter -> Bass)
-> XParse BassStep -> XParse (Maybe BassAlter -> Bass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse BassStep -> XParse BassStep
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bass-step") (XParse BassStep
parseBassStep))
        XParse (Maybe BassAlter -> Bass)
-> XParse (Maybe BassAlter) -> XParse Bass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BassAlter -> XParse (Maybe BassAlter)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse BassAlter -> XParse BassAlter
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bass-alter") (XParse BassAlter
parseBassAlter))

-- | Smart constructor for 'Bass'
mkBass :: BassStep -> Bass
mkBass :: BassStep -> Bass
mkBass BassStep
a = BassStep -> Maybe BassAlter -> Bass
Bass BassStep
a Maybe BassAlter
forall a. Maybe a
Nothing

-- | @bass-alter@ /(complex)/
--
-- The bass-alter type represents the chromatic alteration of the bass of the current chord within the harmony element. In some chord styles, the text for the bass-step element may include bass-alter information. In that case, the print-object attribute of the bass-alter element can be set to no. The location attribute indicates whether the alteration should appear to the left or the right of the bass-step; it is right by default.
data BassAlter = 
      BassAlter {
          BassAlter -> Semitones
bassAlterSemitones :: Semitones -- ^ text content
        , BassAlter -> Maybe LeftRight
bassAlterLocation :: (Maybe LeftRight) -- ^ /location/ attribute
        , BassAlter -> Maybe YesNo
bassAlterPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , BassAlter -> Maybe Tenths
bassAlterDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , BassAlter -> Maybe Tenths
bassAlterDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , BassAlter -> Maybe Tenths
bassAlterRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , BassAlter -> Maybe Tenths
bassAlterRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , BassAlter -> Maybe CommaSeparatedText
bassAlterFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , BassAlter -> Maybe FontStyle
bassAlterFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , BassAlter -> Maybe FontSize
bassAlterFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , BassAlter -> Maybe FontWeight
bassAlterFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , BassAlter -> Maybe Color
bassAlterColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (BassAlter -> BassAlter -> Bool
(BassAlter -> BassAlter -> Bool)
-> (BassAlter -> BassAlter -> Bool) -> Eq BassAlter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BassAlter -> BassAlter -> Bool
$c/= :: BassAlter -> BassAlter -> Bool
== :: BassAlter -> BassAlter -> Bool
$c== :: BassAlter -> BassAlter -> Bool
Eq,Typeable,(forall x. BassAlter -> Rep BassAlter x)
-> (forall x. Rep BassAlter x -> BassAlter) -> Generic BassAlter
forall x. Rep BassAlter x -> BassAlter
forall x. BassAlter -> Rep BassAlter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BassAlter x -> BassAlter
$cfrom :: forall x. BassAlter -> Rep BassAlter x
Generic,Int -> BassAlter -> ShowS
[BassAlter] -> ShowS
BassAlter -> String
(Int -> BassAlter -> ShowS)
-> (BassAlter -> String)
-> ([BassAlter] -> ShowS)
-> Show BassAlter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BassAlter] -> ShowS
$cshowList :: [BassAlter] -> ShowS
show :: BassAlter -> String
$cshow :: BassAlter -> String
showsPrec :: Int -> BassAlter -> ShowS
$cshowsPrec :: Int -> BassAlter -> ShowS
Show)
instance EmitXml BassAlter where
    emitXml :: BassAlter -> XmlRep
emitXml (BassAlter Semitones
a Maybe LeftRight
b Maybe YesNo
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
a)
        ([XmlRep -> (LeftRight -> XmlRep) -> Maybe LeftRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LeftRight -> XmlRep) -> LeftRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftRight
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l])
        []
parseBassAlter :: P.XParse BassAlter
parseBassAlter :: XParse BassAlter
parseBassAlter = 
      Semitones
-> Maybe LeftRight
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> BassAlter
BassAlter
        (Semitones
 -> Maybe LeftRight
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> BassAlter)
-> XParse Semitones
-> XParse
     (Maybe LeftRight
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones)
        XParse
  (Maybe LeftRight
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe LeftRight)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftRight -> XParse (Maybe LeftRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String -> (String -> XParse LeftRight) -> XParse LeftRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftRight
parseLeftRight)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassAlter)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassAlter)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassAlter)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> BassAlter)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> BassAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> BassAlter)
-> XParse (Maybe Color) -> XParse BassAlter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'BassAlter'
mkBassAlter :: Semitones -> BassAlter
mkBassAlter :: Semitones -> BassAlter
mkBassAlter Semitones
a = Semitones
-> Maybe LeftRight
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> BassAlter
BassAlter Semitones
a Maybe LeftRight
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @bass-step@ /(complex)/
--
-- The bass-step type represents the pitch step of the bass of the current chord within the harmony element. The text attribute indicates how the bass should appear in a score if not using the element contents.
data BassStep = 
      BassStep {
          BassStep -> Step
bassStepStep :: Step -- ^ text content
        , BassStep -> Maybe Token
bassStepText :: (Maybe Token) -- ^ /text/ attribute
        , BassStep -> Maybe Tenths
bassStepDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , BassStep -> Maybe Tenths
bassStepDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , BassStep -> Maybe Tenths
bassStepRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , BassStep -> Maybe Tenths
bassStepRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , BassStep -> Maybe CommaSeparatedText
bassStepFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , BassStep -> Maybe FontStyle
bassStepFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , BassStep -> Maybe FontSize
bassStepFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , BassStep -> Maybe FontWeight
bassStepFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , BassStep -> Maybe Color
bassStepColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (BassStep -> BassStep -> Bool
(BassStep -> BassStep -> Bool)
-> (BassStep -> BassStep -> Bool) -> Eq BassStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BassStep -> BassStep -> Bool
$c/= :: BassStep -> BassStep -> Bool
== :: BassStep -> BassStep -> Bool
$c== :: BassStep -> BassStep -> Bool
Eq,Typeable,(forall x. BassStep -> Rep BassStep x)
-> (forall x. Rep BassStep x -> BassStep) -> Generic BassStep
forall x. Rep BassStep x -> BassStep
forall x. BassStep -> Rep BassStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BassStep x -> BassStep
$cfrom :: forall x. BassStep -> Rep BassStep x
Generic,Int -> BassStep -> ShowS
[BassStep] -> ShowS
BassStep -> String
(Int -> BassStep -> ShowS)
-> (BassStep -> String) -> ([BassStep] -> ShowS) -> Show BassStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BassStep] -> ShowS
$cshowList :: [BassStep] -> ShowS
show :: BassStep -> String
$cshow :: BassStep -> String
showsPrec :: Int -> BassStep -> ShowS
$cshowsPrec :: Int -> BassStep -> ShowS
Show)
instance EmitXml BassStep where
    emitXml :: BassStep -> XmlRep
emitXml (BassStep Step
a Maybe Token
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k])
        []
parseBassStep :: P.XParse BassStep
parseBassStep :: XParse BassStep
parseBassStep = 
      Step
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> BassStep
BassStep
        (Step
 -> Maybe Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> BassStep)
-> XParse Step
-> XParse
     (Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep)
        XParse
  (Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe Token)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> BassStep)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassStep)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> BassStep)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> BassStep)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> BassStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> BassStep)
-> XParse (Maybe Color) -> XParse BassStep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'BassStep'
mkBassStep :: Step -> BassStep
mkBassStep :: Step -> BassStep
mkBassStep Step
a = Step
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> BassStep
BassStep Step
a Maybe Token
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @beam@ /(complex)/
--
-- Beam values include begin, continue, end, forward hook, and backward hook. Up to eight concurrent beams are available to cover up to 1024th notes. Each beam in a note is represented with a separate beam element, starting with the eighth note beam using a number attribute of 1.
-- 
-- Note that the beam number does not distinguish sets of beams that overlap, as it does for slur and other elements. Beaming groups are distinguished by being in different voices and/or the presence or absence of grace and cue elements.
-- 
-- Beams that have a begin value can also have a fan attribute to indicate accelerandos and ritardandos using fanned beams. The fan attribute may also be used with a continue value if the fanning direction changes on that note. The value is "none" if not specified.
-- 
-- The repeater attribute has been deprecated in MusicXML 3.0. Formerly used for tremolos, it needs to be specified with a "yes" value for each beam using it.
data Beam = 
      Beam {
          Beam -> BeamValue
beamBeamValue :: BeamValue -- ^ text content
        , Beam -> Maybe BeamLevel
beamNumber :: (Maybe BeamLevel) -- ^ /number/ attribute
        , Beam -> Maybe YesNo
beamRepeater :: (Maybe YesNo) -- ^ /repeater/ attribute
        , Beam -> Maybe Fan
beamFan :: (Maybe Fan) -- ^ /fan/ attribute
        , Beam -> Maybe Color
beamColor :: (Maybe Color) -- ^ /color/ attribute
        , Beam -> Maybe ID
beamId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Beam -> Beam -> Bool
(Beam -> Beam -> Bool) -> (Beam -> Beam -> Bool) -> Eq Beam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Beam -> Beam -> Bool
$c/= :: Beam -> Beam -> Bool
== :: Beam -> Beam -> Bool
$c== :: Beam -> Beam -> Bool
Eq,Typeable,(forall x. Beam -> Rep Beam x)
-> (forall x. Rep Beam x -> Beam) -> Generic Beam
forall x. Rep Beam x -> Beam
forall x. Beam -> Rep Beam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Beam x -> Beam
$cfrom :: forall x. Beam -> Rep Beam x
Generic,Int -> Beam -> ShowS
[Beam] -> ShowS
Beam -> String
(Int -> Beam -> ShowS)
-> (Beam -> String) -> ([Beam] -> ShowS) -> Show Beam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Beam] -> ShowS
$cshowList :: [Beam] -> ShowS
show :: Beam -> String
$cshow :: Beam -> String
showsPrec :: Int -> Beam -> ShowS
$cshowsPrec :: Int -> Beam -> ShowS
Show)
instance EmitXml Beam where
    emitXml :: Beam -> XmlRep
emitXml (Beam BeamValue
a Maybe BeamLevel
b Maybe YesNo
c Maybe Fan
d Maybe Color
e Maybe ID
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (BeamValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeamValue
a)
        ([XmlRep -> (BeamLevel -> XmlRep) -> Maybe BeamLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (BeamLevel -> XmlRep) -> BeamLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BeamLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe BeamLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"repeater" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Fan -> XmlRep) -> Maybe Fan -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"fan" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Fan -> XmlRep) -> Fan -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fan -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Fan
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
f])
        []
parseBeam :: P.XParse Beam
parseBeam :: XParse Beam
parseBeam = 
      BeamValue
-> Maybe BeamLevel
-> Maybe YesNo
-> Maybe Fan
-> Maybe Color
-> Maybe ID
-> Beam
Beam
        (BeamValue
 -> Maybe BeamLevel
 -> Maybe YesNo
 -> Maybe Fan
 -> Maybe Color
 -> Maybe ID
 -> Beam)
-> XParse BeamValue
-> XParse
     (Maybe BeamLevel
      -> Maybe YesNo -> Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse BeamValue) -> XParse BeamValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BeamValue
parseBeamValue)
        XParse
  (Maybe BeamLevel
   -> Maybe YesNo -> Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
-> XParse (Maybe BeamLevel)
-> XParse
     (Maybe YesNo -> Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BeamLevel -> XParse (Maybe BeamLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse BeamLevel) -> XParse BeamLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BeamLevel
parseBeamLevel)
        XParse
  (Maybe YesNo -> Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
-> XParse (Maybe YesNo)
-> XParse (Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"repeater") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe Fan -> Maybe Color -> Maybe ID -> Beam)
-> XParse (Maybe Fan) -> XParse (Maybe Color -> Maybe ID -> Beam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Fan -> XParse (Maybe Fan)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"fan") XParse String -> (String -> XParse Fan) -> XParse Fan
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Fan
parseFan)
        XParse (Maybe Color -> Maybe ID -> Beam)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Beam)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Beam) -> XParse (Maybe ID) -> XParse Beam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Beam'
mkBeam :: BeamValue -> Beam
mkBeam :: BeamValue -> Beam
mkBeam BeamValue
a = BeamValue
-> Maybe BeamLevel
-> Maybe YesNo
-> Maybe Fan
-> Maybe Color
-> Maybe ID
-> Beam
Beam BeamValue
a Maybe BeamLevel
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Fan
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @beat-repeat@ /(complex)/
--
-- The beat-repeat type is used to indicate that a single beat (but possibly many notes) is repeated. Both the start and stop of the beat being repeated should be specified. The slashes attribute specifies the number of slashes to use in the symbol. The use-dots attribute indicates whether or not to use dots as well (for instance, with mixed rhythm patterns). By default, the value for slashes is 1 and the value for use-dots is no.
-- 
-- The beat-repeat element specifies a notation style for repetitions. The actual music being repeated needs to be repeated within the MusicXML file. This element specifies the notation that indicates the repeat.
data BeatRepeat = 
      BeatRepeat {
          BeatRepeat -> StartStop
beatRepeatType :: StartStop -- ^ /type/ attribute
        , BeatRepeat -> Maybe PositiveInteger
beatRepeatSlashes :: (Maybe PositiveInteger) -- ^ /slashes/ attribute
        , BeatRepeat -> Maybe YesNo
beatRepeatUseDots :: (Maybe YesNo) -- ^ /use-dots/ attribute
        , BeatRepeat -> Maybe Slash
beatRepeatSlash :: (Maybe Slash)
       }
    deriving (BeatRepeat -> BeatRepeat -> Bool
(BeatRepeat -> BeatRepeat -> Bool)
-> (BeatRepeat -> BeatRepeat -> Bool) -> Eq BeatRepeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeatRepeat -> BeatRepeat -> Bool
$c/= :: BeatRepeat -> BeatRepeat -> Bool
== :: BeatRepeat -> BeatRepeat -> Bool
$c== :: BeatRepeat -> BeatRepeat -> Bool
Eq,Typeable,(forall x. BeatRepeat -> Rep BeatRepeat x)
-> (forall x. Rep BeatRepeat x -> BeatRepeat) -> Generic BeatRepeat
forall x. Rep BeatRepeat x -> BeatRepeat
forall x. BeatRepeat -> Rep BeatRepeat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeatRepeat x -> BeatRepeat
$cfrom :: forall x. BeatRepeat -> Rep BeatRepeat x
Generic,Int -> BeatRepeat -> ShowS
[BeatRepeat] -> ShowS
BeatRepeat -> String
(Int -> BeatRepeat -> ShowS)
-> (BeatRepeat -> String)
-> ([BeatRepeat] -> ShowS)
-> Show BeatRepeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeatRepeat] -> ShowS
$cshowList :: [BeatRepeat] -> ShowS
show :: BeatRepeat -> String
$cshow :: BeatRepeat -> String
showsPrec :: Int -> BeatRepeat -> ShowS
$cshowsPrec :: Int -> BeatRepeat -> ShowS
Show)
instance EmitXml BeatRepeat where
    emitXml :: BeatRepeat -> XmlRep
emitXml (BeatRepeat StartStop
a Maybe PositiveInteger
b Maybe YesNo
c Maybe Slash
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"slashes" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"use-dots" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c])
        ([Maybe Slash -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Slash
d])
parseBeatRepeat :: P.XParse BeatRepeat
parseBeatRepeat :: XParse BeatRepeat
parseBeatRepeat = 
      StartStop
-> Maybe PositiveInteger
-> Maybe YesNo
-> Maybe Slash
-> BeatRepeat
BeatRepeat
        (StartStop
 -> Maybe PositiveInteger
 -> Maybe YesNo
 -> Maybe Slash
 -> BeatRepeat)
-> XParse StartStop
-> XParse
     (Maybe PositiveInteger -> Maybe YesNo -> Maybe Slash -> BeatRepeat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe PositiveInteger -> Maybe YesNo -> Maybe Slash -> BeatRepeat)
-> XParse (Maybe PositiveInteger)
-> XParse (Maybe YesNo -> Maybe Slash -> BeatRepeat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"slashes") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse (Maybe YesNo -> Maybe Slash -> BeatRepeat)
-> XParse (Maybe YesNo) -> XParse (Maybe Slash -> BeatRepeat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"use-dots") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe Slash -> BeatRepeat)
-> XParse (Maybe Slash) -> XParse BeatRepeat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Slash -> XParse (Maybe Slash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Slash
parseSlash)

-- | Smart constructor for 'BeatRepeat'
mkBeatRepeat :: StartStop -> BeatRepeat
mkBeatRepeat :: StartStop -> BeatRepeat
mkBeatRepeat StartStop
a = StartStop
-> Maybe PositiveInteger
-> Maybe YesNo
-> Maybe Slash
-> BeatRepeat
BeatRepeat StartStop
a Maybe PositiveInteger
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Slash
forall a. Maybe a
Nothing

-- | @beat-unit-tied@ /(complex)/
--
-- The beat-unit-tied type indicates a beat-unit within a metronome mark that is tied to the preceding beat-unit. This allows or two or more tied notes to be associated with a per-minute value in a metronome mark, whereas the metronome-tied element is restricted to metric relationship marks.
data BeatUnitTied = 
      BeatUnitTied {
          BeatUnitTied -> BeatUnit
beatUnitTiedBeatUnit :: BeatUnit
       }
    deriving (BeatUnitTied -> BeatUnitTied -> Bool
(BeatUnitTied -> BeatUnitTied -> Bool)
-> (BeatUnitTied -> BeatUnitTied -> Bool) -> Eq BeatUnitTied
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeatUnitTied -> BeatUnitTied -> Bool
$c/= :: BeatUnitTied -> BeatUnitTied -> Bool
== :: BeatUnitTied -> BeatUnitTied -> Bool
$c== :: BeatUnitTied -> BeatUnitTied -> Bool
Eq,Typeable,(forall x. BeatUnitTied -> Rep BeatUnitTied x)
-> (forall x. Rep BeatUnitTied x -> BeatUnitTied)
-> Generic BeatUnitTied
forall x. Rep BeatUnitTied x -> BeatUnitTied
forall x. BeatUnitTied -> Rep BeatUnitTied x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeatUnitTied x -> BeatUnitTied
$cfrom :: forall x. BeatUnitTied -> Rep BeatUnitTied x
Generic,Int -> BeatUnitTied -> ShowS
[BeatUnitTied] -> ShowS
BeatUnitTied -> String
(Int -> BeatUnitTied -> ShowS)
-> (BeatUnitTied -> String)
-> ([BeatUnitTied] -> ShowS)
-> Show BeatUnitTied
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeatUnitTied] -> ShowS
$cshowList :: [BeatUnitTied] -> ShowS
show :: BeatUnitTied -> String
$cshow :: BeatUnitTied -> String
showsPrec :: Int -> BeatUnitTied -> ShowS
$cshowsPrec :: Int -> BeatUnitTied -> ShowS
Show)
instance EmitXml BeatUnitTied where
    emitXml :: BeatUnitTied -> XmlRep
emitXml (BeatUnitTied BeatUnit
a) =
      [XmlRep] -> XmlRep
XReps [BeatUnit -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeatUnit
a]
parseBeatUnitTied :: P.XParse BeatUnitTied
parseBeatUnitTied :: XParse BeatUnitTied
parseBeatUnitTied = 
      BeatUnit -> BeatUnitTied
BeatUnitTied
        (BeatUnit -> BeatUnitTied)
-> XParse BeatUnit -> XParse BeatUnitTied
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse BeatUnit
parseBeatUnit

-- | Smart constructor for 'BeatUnitTied'
mkBeatUnitTied :: BeatUnit -> BeatUnitTied
mkBeatUnitTied :: BeatUnit -> BeatUnitTied
mkBeatUnitTied BeatUnit
a = BeatUnit -> BeatUnitTied
BeatUnitTied BeatUnit
a

-- | @beater@ /(complex)/
--
-- The beater type represents pictograms for beaters, mallets, and sticks that do not have different materials represented in the pictogram.
data Beater = 
      Beater {
          Beater -> BeaterValue
beaterBeaterValue :: BeaterValue -- ^ text content
        , Beater -> Maybe TipDirection
beaterTip :: (Maybe TipDirection) -- ^ /tip/ attribute
       }
    deriving (Beater -> Beater -> Bool
(Beater -> Beater -> Bool)
-> (Beater -> Beater -> Bool) -> Eq Beater
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Beater -> Beater -> Bool
$c/= :: Beater -> Beater -> Bool
== :: Beater -> Beater -> Bool
$c== :: Beater -> Beater -> Bool
Eq,Typeable,(forall x. Beater -> Rep Beater x)
-> (forall x. Rep Beater x -> Beater) -> Generic Beater
forall x. Rep Beater x -> Beater
forall x. Beater -> Rep Beater x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Beater x -> Beater
$cfrom :: forall x. Beater -> Rep Beater x
Generic,Int -> Beater -> ShowS
[Beater] -> ShowS
Beater -> String
(Int -> Beater -> ShowS)
-> (Beater -> String) -> ([Beater] -> ShowS) -> Show Beater
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Beater] -> ShowS
$cshowList :: [Beater] -> ShowS
show :: Beater -> String
$cshow :: Beater -> String
showsPrec :: Int -> Beater -> ShowS
$cshowsPrec :: Int -> Beater -> ShowS
Show)
instance EmitXml Beater where
    emitXml :: Beater -> XmlRep
emitXml (Beater BeaterValue
a Maybe TipDirection
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (BeaterValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeaterValue
a)
        ([XmlRep -> (TipDirection -> XmlRep) -> Maybe TipDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"tip" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TipDirection -> XmlRep) -> TipDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TipDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TipDirection
b])
        []
parseBeater :: P.XParse Beater
parseBeater :: XParse Beater
parseBeater = 
      BeaterValue -> Maybe TipDirection -> Beater
Beater
        (BeaterValue -> Maybe TipDirection -> Beater)
-> XParse BeaterValue -> XParse (Maybe TipDirection -> Beater)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse BeaterValue) -> XParse BeaterValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BeaterValue
parseBeaterValue)
        XParse (Maybe TipDirection -> Beater)
-> XParse (Maybe TipDirection) -> XParse Beater
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TipDirection -> XParse (Maybe TipDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"tip") XParse String
-> (String -> XParse TipDirection) -> XParse TipDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TipDirection
parseTipDirection)

-- | Smart constructor for 'Beater'
mkBeater :: BeaterValue -> Beater
mkBeater :: BeaterValue -> Beater
mkBeater BeaterValue
a = BeaterValue -> Maybe TipDirection -> Beater
Beater BeaterValue
a Maybe TipDirection
forall a. Maybe a
Nothing

-- | @bend@ /(complex)/
--
-- The bend type is used in guitar and tablature. The bend-alter element indicates the number of steps in the bend, similar to the alter element. As with the alter element, numbers like 0.5 can be used to indicate microtones. Negative numbers indicate pre-bends or releases; the pre-bend and release elements are used to distinguish what is intended. A with-bar element indicates that the bend is to be done at the bridge with a whammy or vibrato bar. The content of the element indicates how this should be notated.
data Bend = 
      Bend {
          Bend -> Maybe Tenths
bendDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Bend -> Maybe Tenths
bendDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Bend -> Maybe Tenths
bendRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Bend -> Maybe Tenths
bendRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Bend -> Maybe CommaSeparatedText
bendFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Bend -> Maybe FontStyle
bendFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Bend -> Maybe FontSize
bendFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Bend -> Maybe FontWeight
bendFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Bend -> Maybe Color
bendColor :: (Maybe Color) -- ^ /color/ attribute
        , Bend -> Maybe YesNo
bendAccelerate :: (Maybe YesNo) -- ^ /accelerate/ attribute
        , Bend -> Maybe TrillBeats
bendBeats :: (Maybe TrillBeats) -- ^ /beats/ attribute
        , Bend -> Maybe Percent
bendFirstBeat :: (Maybe Percent) -- ^ /first-beat/ attribute
        , Bend -> Maybe Percent
bendLastBeat :: (Maybe Percent) -- ^ /last-beat/ attribute
        , Bend -> Semitones
bendBendAlter :: Semitones -- ^ /bend-alter/ child element
        , Bend -> Maybe ChxBend
bendBend :: (Maybe ChxBend)
        , Bend -> Maybe PlacementText
bendWithBar :: (Maybe PlacementText) -- ^ /with-bar/ child element
       }
    deriving (Bend -> Bend -> Bool
(Bend -> Bend -> Bool) -> (Bend -> Bend -> Bool) -> Eq Bend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bend -> Bend -> Bool
$c/= :: Bend -> Bend -> Bool
== :: Bend -> Bend -> Bool
$c== :: Bend -> Bend -> Bool
Eq,Typeable,(forall x. Bend -> Rep Bend x)
-> (forall x. Rep Bend x -> Bend) -> Generic Bend
forall x. Rep Bend x -> Bend
forall x. Bend -> Rep Bend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bend x -> Bend
$cfrom :: forall x. Bend -> Rep Bend x
Generic,Int -> Bend -> ShowS
[Bend] -> ShowS
Bend -> String
(Int -> Bend -> ShowS)
-> (Bend -> String) -> ([Bend] -> ShowS) -> Show Bend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bend] -> ShowS
$cshowList :: [Bend] -> ShowS
show :: Bend -> String
$cshow :: Bend -> String
showsPrec :: Int -> Bend -> ShowS
$cshowsPrec :: Int -> Bend -> ShowS
Show)
instance EmitXml Bend where
    emitXml :: Bend -> XmlRep
emitXml (Bend Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe YesNo
j Maybe TrillBeats
k Maybe Percent
l Maybe Percent
m Semitones
n Maybe ChxBend
o Maybe PlacementText
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"accelerate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillBeats -> XmlRep) -> Maybe TrillBeats -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TrillBeats -> XmlRep) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillBeats -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillBeats
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"first-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"last-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
m])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bend-alter" Maybe String
forall a. Maybe a
Nothing) (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
n)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe ChxBend -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe ChxBend
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PlacementText -> XmlRep) -> Maybe PlacementText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"with-bar" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PlacementText -> XmlRep) -> PlacementText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PlacementText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PlacementText
p])
parseBend :: P.XParse Bend
parseBend :: XParse Bend
parseBend = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> Semitones
-> Maybe ChxBend
-> Maybe PlacementText
-> Bend
Bend
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe TrillBeats
 -> Maybe Percent
 -> Maybe Percent
 -> Semitones
 -> Maybe ChxBend
 -> Maybe PlacementText
 -> Bend)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"accelerate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe TrillBeats)
-> XParse
     (Maybe Percent
      -> Maybe Percent
      -> Semitones
      -> Maybe ChxBend
      -> Maybe PlacementText
      -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillBeats -> XParse (Maybe TrillBeats)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"beats") XParse String -> (String -> XParse TrillBeats) -> XParse TrillBeats
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillBeats
parseTrillBeats)
        XParse
  (Maybe Percent
   -> Maybe Percent
   -> Semitones
   -> Maybe ChxBend
   -> Maybe PlacementText
   -> Bend)
-> XParse (Maybe Percent)
-> XParse
     (Maybe Percent
      -> Semitones -> Maybe ChxBend -> Maybe PlacementText -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"first-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse
  (Maybe Percent
   -> Semitones -> Maybe ChxBend -> Maybe PlacementText -> Bend)
-> XParse (Maybe Percent)
-> XParse
     (Semitones -> Maybe ChxBend -> Maybe PlacementText -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"last-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Semitones -> Maybe ChxBend -> Maybe PlacementText -> Bend)
-> XParse Semitones
-> XParse (Maybe ChxBend -> Maybe PlacementText -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bend-alter") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))
        XParse (Maybe ChxBend -> Maybe PlacementText -> Bend)
-> XParse (Maybe ChxBend) -> XParse (Maybe PlacementText -> Bend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxBend -> XParse (Maybe ChxBend)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse ChxBend
parseChxBend)
        XParse (Maybe PlacementText -> Bend)
-> XParse (Maybe PlacementText) -> XParse Bend
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PlacementText -> XParse (Maybe PlacementText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse PlacementText -> XParse PlacementText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"with-bar") (XParse PlacementText
parsePlacementText))

-- | Smart constructor for 'Bend'
mkBend :: Semitones -> Bend
mkBend :: Semitones -> Bend
mkBend Semitones
n = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> Semitones
-> Maybe ChxBend
-> Maybe PlacementText
-> Bend
Bend Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe TrillBeats
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Semitones
n Maybe ChxBend
forall a. Maybe a
Nothing Maybe PlacementText
forall a. Maybe a
Nothing

-- | @bookmark@ /(complex)/
--
-- The bookmark type serves as a well-defined target for an incoming simple XLink.
data Bookmark = 
      Bookmark {
          Bookmark -> ID
bookmarkId :: ID -- ^ /id/ attribute
        , Bookmark -> Maybe Token
bookmarkName :: (Maybe Token) -- ^ /name/ attribute
        , Bookmark -> Maybe NMTOKEN
bookmarkElement :: (Maybe NMTOKEN) -- ^ /element/ attribute
        , Bookmark -> Maybe PositiveInteger
bookmarkPosition :: (Maybe PositiveInteger) -- ^ /position/ attribute
       }
    deriving (Bookmark -> Bookmark -> Bool
(Bookmark -> Bookmark -> Bool)
-> (Bookmark -> Bookmark -> Bool) -> Eq Bookmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bookmark -> Bookmark -> Bool
$c/= :: Bookmark -> Bookmark -> Bool
== :: Bookmark -> Bookmark -> Bool
$c== :: Bookmark -> Bookmark -> Bool
Eq,Typeable,(forall x. Bookmark -> Rep Bookmark x)
-> (forall x. Rep Bookmark x -> Bookmark) -> Generic Bookmark
forall x. Rep Bookmark x -> Bookmark
forall x. Bookmark -> Rep Bookmark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bookmark x -> Bookmark
$cfrom :: forall x. Bookmark -> Rep Bookmark x
Generic,Int -> Bookmark -> ShowS
[Bookmark] -> ShowS
Bookmark -> String
(Int -> Bookmark -> ShowS)
-> (Bookmark -> String) -> ([Bookmark] -> ShowS) -> Show Bookmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bookmark] -> ShowS
$cshowList :: [Bookmark] -> ShowS
show :: Bookmark -> String
$cshow :: Bookmark -> String
showsPrec :: Int -> Bookmark -> ShowS
$cshowsPrec :: Int -> Bookmark -> ShowS
Show)
instance EmitXml Bookmark where
    emitXml :: Bookmark -> XmlRep
emitXml (Bookmark ID
a Maybe Token
b Maybe NMTOKEN
c Maybe PositiveInteger
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ID
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"element" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"position" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
d])
        []
parseBookmark :: P.XParse Bookmark
parseBookmark :: XParse Bookmark
parseBookmark = 
      ID
-> Maybe Token
-> Maybe NMTOKEN
-> Maybe PositiveInteger
-> Bookmark
Bookmark
        (ID
 -> Maybe Token
 -> Maybe NMTOKEN
 -> Maybe PositiveInteger
 -> Bookmark)
-> XParse ID
-> XParse
     (Maybe Token -> Maybe NMTOKEN -> Maybe PositiveInteger -> Bookmark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Maybe Token -> Maybe NMTOKEN -> Maybe PositiveInteger -> Bookmark)
-> XParse (Maybe Token)
-> XParse (Maybe NMTOKEN -> Maybe PositiveInteger -> Bookmark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe NMTOKEN -> Maybe PositiveInteger -> Bookmark)
-> XParse (Maybe NMTOKEN)
-> XParse (Maybe PositiveInteger -> Bookmark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"element") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse (Maybe PositiveInteger -> Bookmark)
-> XParse (Maybe PositiveInteger) -> XParse Bookmark
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"position") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)

-- | Smart constructor for 'Bookmark'
mkBookmark :: ID -> Bookmark
mkBookmark :: ID -> Bookmark
mkBookmark ID
a = ID
-> Maybe Token
-> Maybe NMTOKEN
-> Maybe PositiveInteger
-> Bookmark
Bookmark ID
a Maybe Token
forall a. Maybe a
Nothing Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe PositiveInteger
forall a. Maybe a
Nothing

-- | @bracket@ /(complex)/
--
-- Brackets are combined with words in a variety of modern directions. The line-end attribute specifies if there is a jog up or down (or both), an arrow, or nothing at the start or end of the bracket. If the line-end is up or down, the length of the jog can be specified using the end-length attribute. The line-type is solid by default.
data Bracket = 
      Bracket {
          Bracket -> StartStopContinue
bracketType :: StartStopContinue -- ^ /type/ attribute
        , Bracket -> Maybe NumberLevel
bracketNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Bracket -> LineEnd
bracketLineEnd :: LineEnd -- ^ /line-end/ attribute
        , Bracket -> Maybe Tenths
bracketEndLength :: (Maybe Tenths) -- ^ /end-length/ attribute
        , Bracket -> Maybe LineType
bracketLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Bracket -> Maybe Tenths
bracketDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Bracket -> Maybe Tenths
bracketSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Bracket -> Maybe Tenths
bracketDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Bracket -> Maybe Tenths
bracketDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Bracket -> Maybe Tenths
bracketRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Bracket -> Maybe Tenths
bracketRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Bracket -> Maybe Color
bracketColor :: (Maybe Color) -- ^ /color/ attribute
        , Bracket -> Maybe ID
bracketId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Bracket -> Bracket -> Bool
(Bracket -> Bracket -> Bool)
-> (Bracket -> Bracket -> Bool) -> Eq Bracket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bracket -> Bracket -> Bool
$c/= :: Bracket -> Bracket -> Bool
== :: Bracket -> Bracket -> Bool
$c== :: Bracket -> Bracket -> Bool
Eq,Typeable,(forall x. Bracket -> Rep Bracket x)
-> (forall x. Rep Bracket x -> Bracket) -> Generic Bracket
forall x. Rep Bracket x -> Bracket
forall x. Bracket -> Rep Bracket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bracket x -> Bracket
$cfrom :: forall x. Bracket -> Rep Bracket x
Generic,Int -> Bracket -> ShowS
[Bracket] -> ShowS
Bracket -> String
(Int -> Bracket -> ShowS)
-> (Bracket -> String) -> ([Bracket] -> ShowS) -> Show Bracket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bracket] -> ShowS
$cshowList :: [Bracket] -> ShowS
show :: Bracket -> String
$cshow :: Bracket -> String
showsPrec :: Int -> Bracket -> ShowS
$cshowsPrec :: Int -> Bracket -> ShowS
Show)
instance EmitXml Bracket where
    emitXml :: Bracket -> XmlRep
emitXml (Bracket StartStopContinue
a Maybe NumberLevel
b LineEnd
c Maybe Tenths
d Maybe LineType
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe Tenths
k Maybe Color
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopContinue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-end" Maybe String
forall a. Maybe a
Nothing) (LineEnd -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml LineEnd
c)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"end-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseBracket :: P.XParse Bracket
parseBracket :: XParse Bracket
parseBracket = 
      StartStopContinue
-> Maybe NumberLevel
-> LineEnd
-> Maybe Tenths
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Bracket
Bracket
        (StartStopContinue
 -> Maybe NumberLevel
 -> LineEnd
 -> Maybe Tenths
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Maybe ID
 -> Bracket)
-> XParse StartStopContinue
-> XParse
     (Maybe NumberLevel
      -> LineEnd
      -> Maybe Tenths
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopContinue) -> XParse StartStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopContinue
parseStartStopContinue)
        XParse
  (Maybe NumberLevel
   -> LineEnd
   -> Maybe Tenths
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe NumberLevel)
-> XParse
     (LineEnd
      -> Maybe Tenths
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (LineEnd
   -> Maybe Tenths
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse LineEnd
-> XParse
     (Maybe Tenths
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-end") XParse String -> (String -> XParse LineEnd) -> XParse LineEnd
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineEnd
parseLineEnd)
        XParse
  (Maybe Tenths
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"end-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Bracket)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Color -> Maybe ID -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Color -> Maybe ID -> Bracket)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Bracket)
-> XParse (Maybe Tenths)
-> XParse (Maybe Color -> Maybe ID -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> Maybe ID -> Bracket)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Bracket)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Bracket) -> XParse (Maybe ID) -> XParse Bracket
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Bracket'
mkBracket :: StartStopContinue -> LineEnd -> Bracket
mkBracket :: StartStopContinue -> LineEnd -> Bracket
mkBracket StartStopContinue
a LineEnd
c = StartStopContinue
-> Maybe NumberLevel
-> LineEnd
-> Maybe Tenths
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Bracket
Bracket StartStopContinue
a Maybe NumberLevel
forall a. Maybe a
Nothing LineEnd
c Maybe Tenths
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @breath-mark@ /(complex)/
--
-- The breath-mark element indicates a place to take a breath.
data BreathMark = 
      BreathMark {
          BreathMark -> BreathMarkValue
breathMarkBreathMarkValue :: BreathMarkValue -- ^ text content
        , BreathMark -> Maybe Tenths
breathMarkDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , BreathMark -> Maybe Tenths
breathMarkDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , BreathMark -> Maybe Tenths
breathMarkRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , BreathMark -> Maybe Tenths
breathMarkRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , BreathMark -> Maybe CommaSeparatedText
breathMarkFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , BreathMark -> Maybe FontStyle
breathMarkFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , BreathMark -> Maybe FontSize
breathMarkFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , BreathMark -> Maybe FontWeight
breathMarkFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , BreathMark -> Maybe Color
breathMarkColor :: (Maybe Color) -- ^ /color/ attribute
        , BreathMark -> Maybe AboveBelow
breathMarkPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (BreathMark -> BreathMark -> Bool
(BreathMark -> BreathMark -> Bool)
-> (BreathMark -> BreathMark -> Bool) -> Eq BreathMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreathMark -> BreathMark -> Bool
$c/= :: BreathMark -> BreathMark -> Bool
== :: BreathMark -> BreathMark -> Bool
$c== :: BreathMark -> BreathMark -> Bool
Eq,Typeable,(forall x. BreathMark -> Rep BreathMark x)
-> (forall x. Rep BreathMark x -> BreathMark) -> Generic BreathMark
forall x. Rep BreathMark x -> BreathMark
forall x. BreathMark -> Rep BreathMark x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BreathMark x -> BreathMark
$cfrom :: forall x. BreathMark -> Rep BreathMark x
Generic,Int -> BreathMark -> ShowS
[BreathMark] -> ShowS
BreathMark -> String
(Int -> BreathMark -> ShowS)
-> (BreathMark -> String)
-> ([BreathMark] -> ShowS)
-> Show BreathMark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreathMark] -> ShowS
$cshowList :: [BreathMark] -> ShowS
show :: BreathMark -> String
$cshow :: BreathMark -> String
showsPrec :: Int -> BreathMark -> ShowS
$cshowsPrec :: Int -> BreathMark -> ShowS
Show)
instance EmitXml BreathMark where
    emitXml :: BreathMark -> XmlRep
emitXml (BreathMark BreathMarkValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (BreathMarkValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BreathMarkValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        []
parseBreathMark :: P.XParse BreathMark
parseBreathMark :: XParse BreathMark
parseBreathMark = 
      BreathMarkValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> BreathMark
BreathMark
        (BreathMarkValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> BreathMark)
-> XParse BreathMarkValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse BreathMarkValue) -> XParse BreathMarkValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BreathMarkValue
parseBreathMarkValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> BreathMark)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> BreathMark)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> BreathMark)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> BreathMark)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> BreathMark)
-> XParse (Maybe AboveBelow) -> XParse BreathMark
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'BreathMark'
mkBreathMark :: BreathMarkValue -> BreathMark
mkBreathMark :: BreathMarkValue -> BreathMark
mkBreathMark BreathMarkValue
a = BreathMarkValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> BreathMark
BreathMark BreathMarkValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @caesura@ /(complex)/
--
-- The caesura element indicates a slight pause. It is notated using a "railroad tracks" symbol or other variations specified in the element content.
data Caesura = 
      Caesura {
          Caesura -> CaesuraValue
caesuraCaesuraValue :: CaesuraValue -- ^ text content
        , Caesura -> Maybe Tenths
caesuraDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Caesura -> Maybe Tenths
caesuraDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Caesura -> Maybe Tenths
caesuraRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Caesura -> Maybe Tenths
caesuraRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Caesura -> Maybe CommaSeparatedText
caesuraFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Caesura -> Maybe FontStyle
caesuraFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Caesura -> Maybe FontSize
caesuraFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Caesura -> Maybe FontWeight
caesuraFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Caesura -> Maybe Color
caesuraColor :: (Maybe Color) -- ^ /color/ attribute
        , Caesura -> Maybe AboveBelow
caesuraPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (Caesura -> Caesura -> Bool
(Caesura -> Caesura -> Bool)
-> (Caesura -> Caesura -> Bool) -> Eq Caesura
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Caesura -> Caesura -> Bool
$c/= :: Caesura -> Caesura -> Bool
== :: Caesura -> Caesura -> Bool
$c== :: Caesura -> Caesura -> Bool
Eq,Typeable,(forall x. Caesura -> Rep Caesura x)
-> (forall x. Rep Caesura x -> Caesura) -> Generic Caesura
forall x. Rep Caesura x -> Caesura
forall x. Caesura -> Rep Caesura x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Caesura x -> Caesura
$cfrom :: forall x. Caesura -> Rep Caesura x
Generic,Int -> Caesura -> ShowS
[Caesura] -> ShowS
Caesura -> String
(Int -> Caesura -> ShowS)
-> (Caesura -> String) -> ([Caesura] -> ShowS) -> Show Caesura
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Caesura] -> ShowS
$cshowList :: [Caesura] -> ShowS
show :: Caesura -> String
$cshow :: Caesura -> String
showsPrec :: Int -> Caesura -> ShowS
$cshowsPrec :: Int -> Caesura -> ShowS
Show)
instance EmitXml Caesura where
    emitXml :: Caesura -> XmlRep
emitXml (Caesura CaesuraValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (CaesuraValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CaesuraValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        []
parseCaesura :: P.XParse Caesura
parseCaesura :: XParse Caesura
parseCaesura = 
      CaesuraValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Caesura
Caesura
        (CaesuraValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Caesura)
-> XParse CaesuraValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse CaesuraValue) -> XParse CaesuraValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CaesuraValue
parseCaesuraValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Caesura)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Caesura)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Caesura)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> Caesura)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> Caesura)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Caesura)
-> XParse (Maybe AboveBelow) -> XParse Caesura
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'Caesura'
mkCaesura :: CaesuraValue -> Caesura
mkCaesura :: CaesuraValue -> Caesura
mkCaesura CaesuraValue
a = CaesuraValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Caesura
Caesura CaesuraValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @cancel@ /(complex)/
--
-- A cancel element indicates that the old key signature should be cancelled before the new one appears. This will always happen when changing to C major or A minor and need not be specified then. The cancel value matches the fifths value of the cancelled key signature (e.g., a cancel of -2 will provide an explicit cancellation for changing from B flat major to F major). The optional location attribute indicates where the cancellation appears relative to the new key signature.
data Cancel = 
      Cancel {
          Cancel -> Fifths
cancelFifths :: Fifths -- ^ text content
        , Cancel -> Maybe CancelLocation
cancelLocation :: (Maybe CancelLocation) -- ^ /location/ attribute
       }
    deriving (Cancel -> Cancel -> Bool
(Cancel -> Cancel -> Bool)
-> (Cancel -> Cancel -> Bool) -> Eq Cancel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cancel -> Cancel -> Bool
$c/= :: Cancel -> Cancel -> Bool
== :: Cancel -> Cancel -> Bool
$c== :: Cancel -> Cancel -> Bool
Eq,Typeable,(forall x. Cancel -> Rep Cancel x)
-> (forall x. Rep Cancel x -> Cancel) -> Generic Cancel
forall x. Rep Cancel x -> Cancel
forall x. Cancel -> Rep Cancel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cancel x -> Cancel
$cfrom :: forall x. Cancel -> Rep Cancel x
Generic,Int -> Cancel -> ShowS
[Cancel] -> ShowS
Cancel -> String
(Int -> Cancel -> ShowS)
-> (Cancel -> String) -> ([Cancel] -> ShowS) -> Show Cancel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cancel] -> ShowS
$cshowList :: [Cancel] -> ShowS
show :: Cancel -> String
$cshow :: Cancel -> String
showsPrec :: Int -> Cancel -> ShowS
$cshowsPrec :: Int -> Cancel -> ShowS
Show)
instance EmitXml Cancel where
    emitXml :: Cancel -> XmlRep
emitXml (Cancel Fifths
a Maybe CancelLocation
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Fifths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fifths
a)
        ([XmlRep
-> (CancelLocation -> XmlRep) -> Maybe CancelLocation -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CancelLocation -> XmlRep) -> CancelLocation -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CancelLocation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CancelLocation
b])
        []
parseCancel :: P.XParse Cancel
parseCancel :: XParse Cancel
parseCancel = 
      Fifths -> Maybe CancelLocation -> Cancel
Cancel
        (Fifths -> Maybe CancelLocation -> Cancel)
-> XParse Fifths -> XParse (Maybe CancelLocation -> Cancel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Fifths) -> XParse Fifths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Fifths
parseFifths)
        XParse (Maybe CancelLocation -> Cancel)
-> XParse (Maybe CancelLocation) -> XParse Cancel
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CancelLocation -> XParse (Maybe CancelLocation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String
-> (String -> XParse CancelLocation) -> XParse CancelLocation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CancelLocation
parseCancelLocation)

-- | Smart constructor for 'Cancel'
mkCancel :: Fifths -> Cancel
mkCancel :: Fifths -> Cancel
mkCancel Fifths
a = Fifths -> Maybe CancelLocation -> Cancel
Cancel Fifths
a Maybe CancelLocation
forall a. Maybe a
Nothing

-- | @clef@ /(complex)/
--
-- Clefs are represented by a combination of sign, line, and clef-octave-change elements. The optional number attribute refers to staff numbers within the part. A value of 1 is assumed if not present.
-- 
-- Sometimes clefs are added to the staff in non-standard line positions, either to indicate cue passages, or when there are multiple clefs present simultaneously on one staff. In this situation, the additional attribute is set to "yes" and the line value is ignored. The size attribute is used for clefs where the additional attribute is "yes". It is typically used to indicate cue clefs.
-- 
-- Sometimes clefs at the start of a measure need to appear after the barline rather than before, as for cues or for use after a repeated section. The after-barline attribute is set to "yes" in this situation. The attribute is ignored for mid-measure clefs.
-- 
-- Clefs appear at the start of each system unless the print-object attribute has been set to "no" or the additional attribute has been set to "yes".
data Clef = 
      Clef {
          Clef -> Maybe StaffNumber
clefNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , Clef -> Maybe YesNo
clefAdditional :: (Maybe YesNo) -- ^ /additional/ attribute
        , Clef -> Maybe SymbolSize
clefSize :: (Maybe SymbolSize) -- ^ /size/ attribute
        , Clef -> Maybe YesNo
clefAfterBarline :: (Maybe YesNo) -- ^ /after-barline/ attribute
        , Clef -> Maybe Tenths
clefDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Clef -> Maybe Tenths
clefDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Clef -> Maybe Tenths
clefRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Clef -> Maybe Tenths
clefRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Clef -> Maybe CommaSeparatedText
clefFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Clef -> Maybe FontStyle
clefFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Clef -> Maybe FontSize
clefFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Clef -> Maybe FontWeight
clefFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Clef -> Maybe Color
clefColor :: (Maybe Color) -- ^ /color/ attribute
        , Clef -> Maybe YesNo
clefPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Clef -> Maybe ID
clefId :: (Maybe ID) -- ^ /id/ attribute
        , Clef -> ClefSign
clefSign :: ClefSign -- ^ /sign/ child element
        , Clef -> Maybe StaffLine
clefLine :: (Maybe StaffLine) -- ^ /line/ child element
        , Clef -> Maybe Int
clefClefOctaveChange :: (Maybe Int) -- ^ /clef-octave-change/ child element
       }
    deriving (Clef -> Clef -> Bool
(Clef -> Clef -> Bool) -> (Clef -> Clef -> Bool) -> Eq Clef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Clef -> Clef -> Bool
$c/= :: Clef -> Clef -> Bool
== :: Clef -> Clef -> Bool
$c== :: Clef -> Clef -> Bool
Eq,Typeable,(forall x. Clef -> Rep Clef x)
-> (forall x. Rep Clef x -> Clef) -> Generic Clef
forall x. Rep Clef x -> Clef
forall x. Clef -> Rep Clef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Clef x -> Clef
$cfrom :: forall x. Clef -> Rep Clef x
Generic,Int -> Clef -> ShowS
[Clef] -> ShowS
Clef -> String
(Int -> Clef -> ShowS)
-> (Clef -> String) -> ([Clef] -> ShowS) -> Show Clef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clef] -> ShowS
$cshowList :: [Clef] -> ShowS
show :: Clef -> String
$cshow :: Clef -> String
showsPrec :: Int -> Clef -> ShowS
$cshowsPrec :: Int -> Clef -> ShowS
Show)
instance EmitXml Clef where
    emitXml :: Clef -> XmlRep
emitXml (Clef Maybe StaffNumber
a Maybe YesNo
b Maybe SymbolSize
c Maybe YesNo
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe CommaSeparatedText
i Maybe FontStyle
j Maybe FontSize
k Maybe FontWeight
l Maybe Color
m Maybe YesNo
n Maybe ID
o ClefSign
p Maybe StaffLine
q Maybe Int
r) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"additional" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SymbolSize -> XmlRep) -> Maybe SymbolSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SymbolSize -> XmlRep) -> SymbolSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SymbolSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SymbolSize
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"after-barline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
o])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sign" Maybe String
forall a. Maybe a
Nothing) (ClefSign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ClefSign
p)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StaffLine -> XmlRep) -> Maybe StaffLine -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"line" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StaffLine -> XmlRep) -> StaffLine -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffLine
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Int -> XmlRep) -> Maybe Int -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"clef-octave-change" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Int -> XmlRep) -> Int -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Int
r])
parseClef :: P.XParse Clef
parseClef :: XParse Clef
parseClef = 
      Maybe StaffNumber
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ClefSign
-> Maybe StaffLine
-> Maybe Int
-> Clef
Clef
        (Maybe StaffNumber
 -> Maybe YesNo
 -> Maybe SymbolSize
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe ID
 -> ClefSign
 -> Maybe StaffLine
 -> Maybe Int
 -> Clef)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe YesNo
      -> Maybe SymbolSize
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe YesNo
   -> Maybe SymbolSize
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe SymbolSize
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"additional") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe SymbolSize
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe SymbolSize)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SymbolSize -> XParse (Maybe SymbolSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String -> (String -> XParse SymbolSize) -> XParse SymbolSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SymbolSize
parseSymbolSize)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"after-barline") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ClefSign
      -> Maybe StaffLine
      -> Maybe Int
      -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ClefSign
   -> Maybe StaffLine
   -> Maybe Int
   -> Clef)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe ID -> ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe ID -> ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ID -> ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ID -> ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
-> XParse (Maybe ID)
-> XParse (ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ClefSign -> Maybe StaffLine -> Maybe Int -> Clef)
-> XParse ClefSign -> XParse (Maybe StaffLine -> Maybe Int -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse ClefSign -> XParse ClefSign
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sign") (XParse String
P.xtext XParse String -> (String -> XParse ClefSign) -> XParse ClefSign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ClefSign
parseClefSign))
        XParse (Maybe StaffLine -> Maybe Int -> Clef)
-> XParse (Maybe StaffLine) -> XParse (Maybe Int -> Clef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffLine -> XParse (Maybe StaffLine)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse StaffLine -> XParse StaffLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"line") (XParse String
P.xtext XParse String -> (String -> XParse StaffLine) -> XParse StaffLine
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffLine
parseStaffLine))
        XParse (Maybe Int -> Clef) -> XParse (Maybe Int) -> XParse Clef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Int -> XParse (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Int -> XParse Int
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"clef-octave-change") (XParse String
P.xtext XParse String -> (String -> XParse Int) -> XParse Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> String -> XParse Int
forall a. Read a => String -> String -> XParse a
P.xread String
"Integer")))

-- | Smart constructor for 'Clef'
mkClef :: ClefSign -> Clef
mkClef :: ClefSign -> Clef
mkClef ClefSign
p = Maybe StaffNumber
-> Maybe YesNo
-> Maybe SymbolSize
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ClefSign
-> Maybe StaffLine
-> Maybe Int
-> Clef
Clef Maybe StaffNumber
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe SymbolSize
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ClefSign
p Maybe StaffLine
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

-- | @coda@ /(complex)/
--
-- The coda type is the visual indicator of a coda sign. The exact glyph can be specified with the smufl attribute. A sound element is also needed to guide playback applications reliably.
data Coda = 
      Coda {
          Coda -> Maybe SmuflCodaGlyphName
codaSmufl :: (Maybe SmuflCodaGlyphName) -- ^ /smufl/ attribute
        , Coda -> Maybe Tenths
codaDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Coda -> Maybe Tenths
codaDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Coda -> Maybe Tenths
codaRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Coda -> Maybe Tenths
codaRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Coda -> Maybe CommaSeparatedText
codaFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Coda -> Maybe FontStyle
codaFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Coda -> Maybe FontSize
codaFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Coda -> Maybe FontWeight
codaFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Coda -> Maybe Color
codaColor :: (Maybe Color) -- ^ /color/ attribute
        , Coda -> Maybe LeftCenterRight
codaHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Coda -> Maybe Valign
codaValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Coda -> Maybe ID
codaId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Coda -> Coda -> Bool
(Coda -> Coda -> Bool) -> (Coda -> Coda -> Bool) -> Eq Coda
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coda -> Coda -> Bool
$c/= :: Coda -> Coda -> Bool
== :: Coda -> Coda -> Bool
$c== :: Coda -> Coda -> Bool
Eq,Typeable,(forall x. Coda -> Rep Coda x)
-> (forall x. Rep Coda x -> Coda) -> Generic Coda
forall x. Rep Coda x -> Coda
forall x. Coda -> Rep Coda x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coda x -> Coda
$cfrom :: forall x. Coda -> Rep Coda x
Generic,Int -> Coda -> ShowS
[Coda] -> ShowS
Coda -> String
(Int -> Coda -> ShowS)
-> (Coda -> String) -> ([Coda] -> ShowS) -> Show Coda
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coda] -> ShowS
$cshowList :: [Coda] -> ShowS
show :: Coda -> String
$cshow :: Coda -> String
showsPrec :: Int -> Coda -> ShowS
$cshowsPrec :: Int -> Coda -> ShowS
Show)
instance EmitXml Coda where
    emitXml :: Coda -> XmlRep
emitXml (Coda Maybe SmuflCodaGlyphName
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (SmuflCodaGlyphName -> XmlRep)
-> Maybe SmuflCodaGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflCodaGlyphName -> XmlRep) -> SmuflCodaGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflCodaGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflCodaGlyphName
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseCoda :: P.XParse Coda
parseCoda :: XParse Coda
parseCoda = 
      Maybe SmuflCodaGlyphName
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Coda
Coda
        (Maybe SmuflCodaGlyphName
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> Coda)
-> XParse (Maybe SmuflCodaGlyphName)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SmuflCodaGlyphName -> XParse (Maybe SmuflCodaGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflCodaGlyphName)
-> XParse SmuflCodaGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflCodaGlyphName
parseSmuflCodaGlyphName)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Coda)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Coda)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Coda)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> Coda)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> Coda)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> Coda) -> XParse (Maybe ID) -> XParse Coda
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Coda'
mkCoda :: Coda
mkCoda :: Coda
mkCoda = Maybe SmuflCodaGlyphName
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Coda
Coda Maybe SmuflCodaGlyphName
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @credit@ /(complex)/
--
-- The credit type represents the appearance of the title, composer, arranger, lyricist, copyright, dedication, and other text, symbols, and graphics that commonly appear on the first page of a score. The credit-words, credit-symbol, and credit-image elements are similar to the words, symbol, and image elements for directions. However, since the credit is not part of a measure, the default-x and default-y attributes adjust the origin relative to the bottom left-hand corner of the page. The enclosure for credit-words and credit-symbol is none by default.
-- 
-- By default, a series of credit-words and credit-symbol elements within a single credit element follow one another in sequence visually. Non-positional formatting attributes are carried over from the previous element by default.
-- 
-- The page attribute for the credit element specifies the page number where the credit should appear. This is an integer value that starts with 1 for the first page. Its value is 1 by default. Since credits occur before the music, these page numbers do not refer to the page numbering specified by the print element's page-number attribute.
-- 
-- The credit-type element indicates the purpose behind a credit. Multiple types of data may be combined in a single credit, so multiple elements may be used. Standard values include page number, title, subtitle, composer, arranger, lyricist, and rights.
data Credit = 
      Credit {
          Credit -> Maybe PositiveInteger
creditPage :: (Maybe PositiveInteger) -- ^ /page/ attribute
        , Credit -> Maybe ID
creditId :: (Maybe ID) -- ^ /id/ attribute
        , Credit -> [String]
creditCreditType :: [String] -- ^ /credit-type/ child element
        , Credit -> [Link]
creditLink :: [Link] -- ^ /link/ child element
        , Credit -> [Bookmark]
creditBookmark :: [Bookmark] -- ^ /bookmark/ child element
        , Credit -> ChxCredit
creditCredit :: ChxCredit
       }
    deriving (Credit -> Credit -> Bool
(Credit -> Credit -> Bool)
-> (Credit -> Credit -> Bool) -> Eq Credit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credit -> Credit -> Bool
$c/= :: Credit -> Credit -> Bool
== :: Credit -> Credit -> Bool
$c== :: Credit -> Credit -> Bool
Eq,Typeable,(forall x. Credit -> Rep Credit x)
-> (forall x. Rep Credit x -> Credit) -> Generic Credit
forall x. Rep Credit x -> Credit
forall x. Credit -> Rep Credit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Credit x -> Credit
$cfrom :: forall x. Credit -> Rep Credit x
Generic,Int -> Credit -> ShowS
[Credit] -> ShowS
Credit -> String
(Int -> Credit -> ShowS)
-> (Credit -> String) -> ([Credit] -> ShowS) -> Show Credit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Credit] -> ShowS
$cshowList :: [Credit] -> ShowS
show :: Credit -> String
$cshow :: Credit -> String
showsPrec :: Int -> Credit -> ShowS
$cshowsPrec :: Int -> Credit -> ShowS
Show)
instance EmitXml Credit where
    emitXml :: Credit -> XmlRep
emitXml (Credit Maybe PositiveInteger
a Maybe ID
b [String]
c [Link]
d [Bookmark]
e ChxCredit
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"page" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
b])
        ((String -> XmlRep) -> [String] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [String]
c [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Link -> XmlRep) -> [Link] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"link" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Link -> XmlRep) -> Link -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Link -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Link]
d [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Bookmark -> XmlRep) -> [Bookmark] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bookmark" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Bookmark -> XmlRep) -> Bookmark -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Bookmark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Bookmark]
e [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [ChxCredit -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxCredit
f])
parseCredit :: P.XParse Credit
parseCredit :: XParse Credit
parseCredit = 
      Maybe PositiveInteger
-> Maybe ID
-> [String]
-> [Link]
-> [Bookmark]
-> ChxCredit
-> Credit
Credit
        (Maybe PositiveInteger
 -> Maybe ID
 -> [String]
 -> [Link]
 -> [Bookmark]
 -> ChxCredit
 -> Credit)
-> XParse (Maybe PositiveInteger)
-> XParse
     (Maybe ID
      -> [String] -> [Link] -> [Bookmark] -> ChxCredit -> Credit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"page") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse
  (Maybe ID
   -> [String] -> [Link] -> [Bookmark] -> ChxCredit -> Credit)
-> XParse (Maybe ID)
-> XParse ([String] -> [Link] -> [Bookmark] -> ChxCredit -> Credit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([String] -> [Link] -> [Bookmark] -> ChxCredit -> Credit)
-> XParse [String]
-> XParse ([Link] -> [Bookmark] -> ChxCredit -> Credit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-type") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse ([Link] -> [Bookmark] -> ChxCredit -> Credit)
-> XParse [Link] -> XParse ([Bookmark] -> ChxCredit -> Credit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Link -> XParse [Link]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Link -> XParse Link
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"link") (XParse Link
parseLink))
        XParse ([Bookmark] -> ChxCredit -> Credit)
-> XParse [Bookmark] -> XParse (ChxCredit -> Credit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Bookmark -> XParse [Bookmark]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Bookmark -> XParse Bookmark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bookmark") (XParse Bookmark
parseBookmark))
        XParse (ChxCredit -> Credit) -> XParse ChxCredit -> XParse Credit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxCredit
parseChxCredit

-- | Smart constructor for 'Credit'
mkCredit :: ChxCredit -> Credit
mkCredit :: ChxCredit -> Credit
mkCredit ChxCredit
f = Maybe PositiveInteger
-> Maybe ID
-> [String]
-> [Link]
-> [Bookmark]
-> ChxCredit
-> Credit
Credit Maybe PositiveInteger
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing [] [] [] ChxCredit
f

-- | @dashes@ /(complex)/
--
-- The dashes type represents dashes, used for instance with cresc. and dim. marks.
data Dashes = 
      Dashes {
          Dashes -> StartStopContinue
dashesType :: StartStopContinue -- ^ /type/ attribute
        , Dashes -> Maybe NumberLevel
dashesNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Dashes -> Maybe Tenths
dashesDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Dashes -> Maybe Tenths
dashesSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Dashes -> Maybe Tenths
dashesDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Dashes -> Maybe Tenths
dashesDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Dashes -> Maybe Tenths
dashesRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Dashes -> Maybe Tenths
dashesRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Dashes -> Maybe Color
dashesColor :: (Maybe Color) -- ^ /color/ attribute
        , Dashes -> Maybe ID
dashesId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Dashes -> Dashes -> Bool
(Dashes -> Dashes -> Bool)
-> (Dashes -> Dashes -> Bool) -> Eq Dashes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dashes -> Dashes -> Bool
$c/= :: Dashes -> Dashes -> Bool
== :: Dashes -> Dashes -> Bool
$c== :: Dashes -> Dashes -> Bool
Eq,Typeable,(forall x. Dashes -> Rep Dashes x)
-> (forall x. Rep Dashes x -> Dashes) -> Generic Dashes
forall x. Rep Dashes x -> Dashes
forall x. Dashes -> Rep Dashes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dashes x -> Dashes
$cfrom :: forall x. Dashes -> Rep Dashes x
Generic,Int -> Dashes -> ShowS
[Dashes] -> ShowS
Dashes -> String
(Int -> Dashes -> ShowS)
-> (Dashes -> String) -> ([Dashes] -> ShowS) -> Show Dashes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dashes] -> ShowS
$cshowList :: [Dashes] -> ShowS
show :: Dashes -> String
$cshow :: Dashes -> String
showsPrec :: Int -> Dashes -> ShowS
$cshowsPrec :: Int -> Dashes -> ShowS
Show)
instance EmitXml Dashes where
    emitXml :: Dashes -> XmlRep
emitXml (Dashes StartStopContinue
a Maybe NumberLevel
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Color
i Maybe ID
j) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopContinue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
j])
        []
parseDashes :: P.XParse Dashes
parseDashes :: XParse Dashes
parseDashes = 
      StartStopContinue
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Dashes
Dashes
        (StartStopContinue
 -> Maybe NumberLevel
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Maybe ID
 -> Dashes)
-> XParse StartStopContinue
-> XParse
     (Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Dashes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopContinue) -> XParse StartStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopContinue
parseStartStopContinue)
        XParse
  (Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Dashes)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Dashes)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Dashes)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Dashes)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Dashes)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Maybe ID -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Maybe ID -> Dashes)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Dashes)
-> XParse (Maybe Tenths)
-> XParse (Maybe Color -> Maybe ID -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> Maybe ID -> Dashes)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Dashes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Dashes) -> XParse (Maybe ID) -> XParse Dashes
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Dashes'
mkDashes :: StartStopContinue -> Dashes
mkDashes :: StartStopContinue -> Dashes
mkDashes StartStopContinue
a = StartStopContinue
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Dashes
Dashes StartStopContinue
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @defaults@ /(complex)/
--
-- The defaults type specifies score-wide defaults for scaling, layout, and appearance.
data Defaults = 
      Defaults {
          Defaults -> Maybe Scaling
defaultsScaling :: (Maybe Scaling) -- ^ /scaling/ child element
        , Defaults -> Layout
defaultsLayout :: Layout
        , Defaults -> Maybe Appearance
defaultsAppearance :: (Maybe Appearance) -- ^ /appearance/ child element
        , Defaults -> Maybe EmptyFont
defaultsMusicFont :: (Maybe EmptyFont) -- ^ /music-font/ child element
        , Defaults -> Maybe EmptyFont
defaultsWordFont :: (Maybe EmptyFont) -- ^ /word-font/ child element
        , Defaults -> [LyricFont]
defaultsLyricFont :: [LyricFont] -- ^ /lyric-font/ child element
        , Defaults -> [LyricLanguage]
defaultsLyricLanguage :: [LyricLanguage] -- ^ /lyric-language/ child element
       }
    deriving (Defaults -> Defaults -> Bool
(Defaults -> Defaults -> Bool)
-> (Defaults -> Defaults -> Bool) -> Eq Defaults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Defaults -> Defaults -> Bool
$c/= :: Defaults -> Defaults -> Bool
== :: Defaults -> Defaults -> Bool
$c== :: Defaults -> Defaults -> Bool
Eq,Typeable,(forall x. Defaults -> Rep Defaults x)
-> (forall x. Rep Defaults x -> Defaults) -> Generic Defaults
forall x. Rep Defaults x -> Defaults
forall x. Defaults -> Rep Defaults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Defaults x -> Defaults
$cfrom :: forall x. Defaults -> Rep Defaults x
Generic,Int -> Defaults -> ShowS
[Defaults] -> ShowS
Defaults -> String
(Int -> Defaults -> ShowS)
-> (Defaults -> String) -> ([Defaults] -> ShowS) -> Show Defaults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Defaults] -> ShowS
$cshowList :: [Defaults] -> ShowS
show :: Defaults -> String
$cshow :: Defaults -> String
showsPrec :: Int -> Defaults -> ShowS
$cshowsPrec :: Int -> Defaults -> ShowS
Show)
instance EmitXml Defaults where
    emitXml :: Defaults -> XmlRep
emitXml (Defaults Maybe Scaling
a Layout
b Maybe Appearance
c Maybe EmptyFont
d Maybe EmptyFont
e [LyricFont]
f [LyricLanguage]
g) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Scaling -> XmlRep) -> Maybe Scaling -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"scaling" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Scaling -> XmlRep) -> Scaling -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Scaling -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Scaling
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Layout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Layout
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Appearance -> XmlRep) -> Maybe Appearance -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"appearance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Appearance -> XmlRep) -> Appearance -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Appearance -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Appearance
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (EmptyFont -> XmlRep) -> Maybe EmptyFont -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"music-font" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (EmptyFont -> XmlRep) -> EmptyFont -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EmptyFont -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EmptyFont
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (EmptyFont -> XmlRep) -> Maybe EmptyFont -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"word-font" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (EmptyFont -> XmlRep) -> EmptyFont -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EmptyFont -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EmptyFont
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (LyricFont -> XmlRep) -> [LyricFont] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"lyric-font" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LyricFont -> XmlRep) -> LyricFont -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LyricFont -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [LyricFont]
f [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (LyricLanguage -> XmlRep) -> [LyricLanguage] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"lyric-language" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LyricLanguage -> XmlRep) -> LyricLanguage -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LyricLanguage -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [LyricLanguage]
g)
parseDefaults :: P.XParse Defaults
parseDefaults :: XParse Defaults
parseDefaults = 
      Maybe Scaling
-> Layout
-> Maybe Appearance
-> Maybe EmptyFont
-> Maybe EmptyFont
-> [LyricFont]
-> [LyricLanguage]
-> Defaults
Defaults
        (Maybe Scaling
 -> Layout
 -> Maybe Appearance
 -> Maybe EmptyFont
 -> Maybe EmptyFont
 -> [LyricFont]
 -> [LyricLanguage]
 -> Defaults)
-> XParse (Maybe Scaling)
-> XParse
     (Layout
      -> Maybe Appearance
      -> Maybe EmptyFont
      -> Maybe EmptyFont
      -> [LyricFont]
      -> [LyricLanguage]
      -> Defaults)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Scaling -> XParse (Maybe Scaling)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Scaling -> XParse Scaling
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"scaling") (XParse Scaling
parseScaling))
        XParse
  (Layout
   -> Maybe Appearance
   -> Maybe EmptyFont
   -> Maybe EmptyFont
   -> [LyricFont]
   -> [LyricLanguage]
   -> Defaults)
-> XParse Layout
-> XParse
     (Maybe Appearance
      -> Maybe EmptyFont
      -> Maybe EmptyFont
      -> [LyricFont]
      -> [LyricLanguage]
      -> Defaults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Layout
parseLayout
        XParse
  (Maybe Appearance
   -> Maybe EmptyFont
   -> Maybe EmptyFont
   -> [LyricFont]
   -> [LyricLanguage]
   -> Defaults)
-> XParse (Maybe Appearance)
-> XParse
     (Maybe EmptyFont
      -> Maybe EmptyFont -> [LyricFont] -> [LyricLanguage] -> Defaults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Appearance -> XParse (Maybe Appearance)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Appearance -> XParse Appearance
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"appearance") (XParse Appearance
parseAppearance))
        XParse
  (Maybe EmptyFont
   -> Maybe EmptyFont -> [LyricFont] -> [LyricLanguage] -> Defaults)
-> XParse (Maybe EmptyFont)
-> XParse
     (Maybe EmptyFont -> [LyricFont] -> [LyricLanguage] -> Defaults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EmptyFont -> XParse (Maybe EmptyFont)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse EmptyFont -> XParse EmptyFont
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"music-font") (XParse EmptyFont
parseEmptyFont))
        XParse
  (Maybe EmptyFont -> [LyricFont] -> [LyricLanguage] -> Defaults)
-> XParse (Maybe EmptyFont)
-> XParse ([LyricFont] -> [LyricLanguage] -> Defaults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EmptyFont -> XParse (Maybe EmptyFont)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse EmptyFont -> XParse EmptyFont
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"word-font") (XParse EmptyFont
parseEmptyFont))
        XParse ([LyricFont] -> [LyricLanguage] -> Defaults)
-> XParse [LyricFont] -> XParse ([LyricLanguage] -> Defaults)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LyricFont -> XParse [LyricFont]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse LyricFont -> XParse LyricFont
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"lyric-font") (XParse LyricFont
parseLyricFont))
        XParse ([LyricLanguage] -> Defaults)
-> XParse [LyricLanguage] -> XParse Defaults
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LyricLanguage -> XParse [LyricLanguage]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse LyricLanguage -> XParse LyricLanguage
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"lyric-language") (XParse LyricLanguage
parseLyricLanguage))

-- | Smart constructor for 'Defaults'
mkDefaults :: Layout -> Defaults
mkDefaults :: Layout -> Defaults
mkDefaults Layout
b = Maybe Scaling
-> Layout
-> Maybe Appearance
-> Maybe EmptyFont
-> Maybe EmptyFont
-> [LyricFont]
-> [LyricLanguage]
-> Defaults
Defaults Maybe Scaling
forall a. Maybe a
Nothing Layout
b Maybe Appearance
forall a. Maybe a
Nothing Maybe EmptyFont
forall a. Maybe a
Nothing Maybe EmptyFont
forall a. Maybe a
Nothing [] []

-- | @degree@ /(complex)/
--
-- The degree type is used to add, alter, or subtract individual notes in the chord. The print-object attribute can be used to keep the degree from printing separately when it has already taken into account in the text attribute of the kind element. The degree-value and degree-type text attributes specify how the value and type of the degree should be displayed.
-- 
-- A harmony of kind "other" can be spelled explicitly by using a series of degree elements together with a root.
data Degree = 
      Degree {
          Degree -> Maybe YesNo
degreePrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Degree -> DegreeValue
degreeDegreeValue :: DegreeValue -- ^ /degree-value/ child element
        , Degree -> DegreeAlter
degreeDegreeAlter :: DegreeAlter -- ^ /degree-alter/ child element
        , Degree -> DegreeType
degreeDegreeType :: DegreeType -- ^ /degree-type/ child element
       }
    deriving (Degree -> Degree -> Bool
(Degree -> Degree -> Bool)
-> (Degree -> Degree -> Bool) -> Eq Degree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Degree -> Degree -> Bool
$c/= :: Degree -> Degree -> Bool
== :: Degree -> Degree -> Bool
$c== :: Degree -> Degree -> Bool
Eq,Typeable,(forall x. Degree -> Rep Degree x)
-> (forall x. Rep Degree x -> Degree) -> Generic Degree
forall x. Rep Degree x -> Degree
forall x. Degree -> Rep Degree x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Degree x -> Degree
$cfrom :: forall x. Degree -> Rep Degree x
Generic,Int -> Degree -> ShowS
[Degree] -> ShowS
Degree -> String
(Int -> Degree -> ShowS)
-> (Degree -> String) -> ([Degree] -> ShowS) -> Show Degree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Degree] -> ShowS
$cshowList :: [Degree] -> ShowS
show :: Degree -> String
$cshow :: Degree -> String
showsPrec :: Int -> Degree -> ShowS
$cshowsPrec :: Int -> Degree -> ShowS
Show)
instance EmitXml Degree where
    emitXml :: Degree -> XmlRep
emitXml (Degree Maybe YesNo
a DegreeValue
b DegreeAlter
c DegreeType
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"degree-value" Maybe String
forall a. Maybe a
Nothing) (DegreeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml DegreeValue
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"degree-alter" Maybe String
forall a. Maybe a
Nothing) (DegreeAlter -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml DegreeAlter
c)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"degree-type" Maybe String
forall a. Maybe a
Nothing) (DegreeType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml DegreeType
d)])
parseDegree :: P.XParse Degree
parseDegree :: XParse Degree
parseDegree = 
      Maybe YesNo -> DegreeValue -> DegreeAlter -> DegreeType -> Degree
Degree
        (Maybe YesNo -> DegreeValue -> DegreeAlter -> DegreeType -> Degree)
-> XParse (Maybe YesNo)
-> XParse (DegreeValue -> DegreeAlter -> DegreeType -> Degree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (DegreeValue -> DegreeAlter -> DegreeType -> Degree)
-> XParse DegreeValue
-> XParse (DegreeAlter -> DegreeType -> Degree)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse DegreeValue -> XParse DegreeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"degree-value") (XParse DegreeValue
parseDegreeValue))
        XParse (DegreeAlter -> DegreeType -> Degree)
-> XParse DegreeAlter -> XParse (DegreeType -> Degree)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse DegreeAlter -> XParse DegreeAlter
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"degree-alter") (XParse DegreeAlter
parseDegreeAlter))
        XParse (DegreeType -> Degree) -> XParse DegreeType -> XParse Degree
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse DegreeType -> XParse DegreeType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"degree-type") (XParse DegreeType
parseDegreeType))

-- | Smart constructor for 'Degree'
mkDegree :: DegreeValue -> DegreeAlter -> DegreeType -> Degree
mkDegree :: DegreeValue -> DegreeAlter -> DegreeType -> Degree
mkDegree DegreeValue
b DegreeAlter
c DegreeType
d = Maybe YesNo -> DegreeValue -> DegreeAlter -> DegreeType -> Degree
Degree Maybe YesNo
forall a. Maybe a
Nothing DegreeValue
b DegreeAlter
c DegreeType
d

-- | @degree-alter@ /(complex)/
--
-- The degree-alter type represents the chromatic alteration for the current degree. If the degree-type value is alter or subtract, the degree-alter value is relative to the degree already in the chord based on its kind element. If the degree-type value is add, the degree-alter is relative to a dominant chord (major and perfect intervals except for a minor seventh). The plus-minus attribute is used to indicate if plus and minus symbols should be used instead of sharp and flat symbols to display the degree alteration; it is no by default.
data DegreeAlter = 
      DegreeAlter {
          DegreeAlter -> Semitones
degreeAlterSemitones :: Semitones -- ^ text content
        , DegreeAlter -> Maybe YesNo
degreeAlterPlusMinus :: (Maybe YesNo) -- ^ /plus-minus/ attribute
        , DegreeAlter -> Maybe Tenths
degreeAlterDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , DegreeAlter -> Maybe Tenths
degreeAlterDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , DegreeAlter -> Maybe Tenths
degreeAlterRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , DegreeAlter -> Maybe Tenths
degreeAlterRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , DegreeAlter -> Maybe CommaSeparatedText
degreeAlterFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , DegreeAlter -> Maybe FontStyle
degreeAlterFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , DegreeAlter -> Maybe FontSize
degreeAlterFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , DegreeAlter -> Maybe FontWeight
degreeAlterFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , DegreeAlter -> Maybe Color
degreeAlterColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (DegreeAlter -> DegreeAlter -> Bool
(DegreeAlter -> DegreeAlter -> Bool)
-> (DegreeAlter -> DegreeAlter -> Bool) -> Eq DegreeAlter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DegreeAlter -> DegreeAlter -> Bool
$c/= :: DegreeAlter -> DegreeAlter -> Bool
== :: DegreeAlter -> DegreeAlter -> Bool
$c== :: DegreeAlter -> DegreeAlter -> Bool
Eq,Typeable,(forall x. DegreeAlter -> Rep DegreeAlter x)
-> (forall x. Rep DegreeAlter x -> DegreeAlter)
-> Generic DegreeAlter
forall x. Rep DegreeAlter x -> DegreeAlter
forall x. DegreeAlter -> Rep DegreeAlter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DegreeAlter x -> DegreeAlter
$cfrom :: forall x. DegreeAlter -> Rep DegreeAlter x
Generic,Int -> DegreeAlter -> ShowS
[DegreeAlter] -> ShowS
DegreeAlter -> String
(Int -> DegreeAlter -> ShowS)
-> (DegreeAlter -> String)
-> ([DegreeAlter] -> ShowS)
-> Show DegreeAlter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DegreeAlter] -> ShowS
$cshowList :: [DegreeAlter] -> ShowS
show :: DegreeAlter -> String
$cshow :: DegreeAlter -> String
showsPrec :: Int -> DegreeAlter -> ShowS
$cshowsPrec :: Int -> DegreeAlter -> ShowS
Show)
instance EmitXml DegreeAlter where
    emitXml :: DegreeAlter -> XmlRep
emitXml (DegreeAlter Semitones
a Maybe YesNo
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"plus-minus" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k])
        []
parseDegreeAlter :: P.XParse DegreeAlter
parseDegreeAlter :: XParse DegreeAlter
parseDegreeAlter = 
      Semitones
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeAlter
DegreeAlter
        (Semitones
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> DegreeAlter)
-> XParse Semitones
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"plus-minus") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeAlter)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeAlter)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> DegreeAlter)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> DegreeAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> DegreeAlter)
-> XParse (Maybe Color) -> XParse DegreeAlter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'DegreeAlter'
mkDegreeAlter :: Semitones -> DegreeAlter
mkDegreeAlter :: Semitones -> DegreeAlter
mkDegreeAlter Semitones
a = Semitones
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeAlter
DegreeAlter Semitones
a Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @degree-type@ /(complex)/
--
-- The degree-type type indicates if this degree is an addition, alteration, or subtraction relative to the kind of the current chord. The value of the degree-type element affects the interpretation of the value of the degree-alter element. The text attribute specifies how the type of the degree should be displayed in a score.
data DegreeType = 
      DegreeType {
          DegreeType -> DegreeTypeValue
degreeTypeDegreeTypeValue :: DegreeTypeValue -- ^ text content
        , DegreeType -> Maybe Token
degreeTypeText :: (Maybe Token) -- ^ /text/ attribute
        , DegreeType -> Maybe Tenths
degreeTypeDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , DegreeType -> Maybe Tenths
degreeTypeDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , DegreeType -> Maybe Tenths
degreeTypeRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , DegreeType -> Maybe Tenths
degreeTypeRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , DegreeType -> Maybe CommaSeparatedText
degreeTypeFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , DegreeType -> Maybe FontStyle
degreeTypeFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , DegreeType -> Maybe FontSize
degreeTypeFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , DegreeType -> Maybe FontWeight
degreeTypeFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , DegreeType -> Maybe Color
degreeTypeColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (DegreeType -> DegreeType -> Bool
(DegreeType -> DegreeType -> Bool)
-> (DegreeType -> DegreeType -> Bool) -> Eq DegreeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DegreeType -> DegreeType -> Bool
$c/= :: DegreeType -> DegreeType -> Bool
== :: DegreeType -> DegreeType -> Bool
$c== :: DegreeType -> DegreeType -> Bool
Eq,Typeable,(forall x. DegreeType -> Rep DegreeType x)
-> (forall x. Rep DegreeType x -> DegreeType) -> Generic DegreeType
forall x. Rep DegreeType x -> DegreeType
forall x. DegreeType -> Rep DegreeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DegreeType x -> DegreeType
$cfrom :: forall x. DegreeType -> Rep DegreeType x
Generic,Int -> DegreeType -> ShowS
[DegreeType] -> ShowS
DegreeType -> String
(Int -> DegreeType -> ShowS)
-> (DegreeType -> String)
-> ([DegreeType] -> ShowS)
-> Show DegreeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DegreeType] -> ShowS
$cshowList :: [DegreeType] -> ShowS
show :: DegreeType -> String
$cshow :: DegreeType -> String
showsPrec :: Int -> DegreeType -> ShowS
$cshowsPrec :: Int -> DegreeType -> ShowS
Show)
instance EmitXml DegreeType where
    emitXml :: DegreeType -> XmlRep
emitXml (DegreeType DegreeTypeValue
a Maybe Token
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (DegreeTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml DegreeTypeValue
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k])
        []
parseDegreeType :: P.XParse DegreeType
parseDegreeType :: XParse DegreeType
parseDegreeType = 
      DegreeTypeValue
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeType
DegreeType
        (DegreeTypeValue
 -> Maybe Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> DegreeType)
-> XParse DegreeTypeValue
-> XParse
     (Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse DegreeTypeValue) -> XParse DegreeTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse DegreeTypeValue
parseDegreeTypeValue)
        XParse
  (Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe Token)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeType)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeType)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeType)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> DegreeType)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> DegreeType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> DegreeType)
-> XParse (Maybe Color) -> XParse DegreeType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'DegreeType'
mkDegreeType :: DegreeTypeValue -> DegreeType
mkDegreeType :: DegreeTypeValue -> DegreeType
mkDegreeType DegreeTypeValue
a = DegreeTypeValue
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeType
DegreeType DegreeTypeValue
a Maybe Token
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @degree-value@ /(complex)/
--
-- The content of the degree-value type is a number indicating the degree of the chord (1 for the root, 3 for third, etc). The text attribute specifies how the type of the degree should be displayed in a score. The degree-value symbol attribute indicates that a symbol should be used in specifying the degree. If the symbol attribute is present, the value of the text attribute follows the symbol.
data DegreeValue = 
      DegreeValue {
          DegreeValue -> PositiveInteger
degreeValuePositiveInteger :: PositiveInteger -- ^ text content
        , DegreeValue -> Maybe DegreeSymbolValue
degreeValueSymbol :: (Maybe DegreeSymbolValue) -- ^ /symbol/ attribute
        , DegreeValue -> Maybe Token
degreeValueText :: (Maybe Token) -- ^ /text/ attribute
        , DegreeValue -> Maybe Tenths
degreeValueDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , DegreeValue -> Maybe Tenths
degreeValueDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , DegreeValue -> Maybe Tenths
degreeValueRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , DegreeValue -> Maybe Tenths
degreeValueRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , DegreeValue -> Maybe CommaSeparatedText
degreeValueFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , DegreeValue -> Maybe FontStyle
degreeValueFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , DegreeValue -> Maybe FontSize
degreeValueFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , DegreeValue -> Maybe FontWeight
degreeValueFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , DegreeValue -> Maybe Color
degreeValueColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (DegreeValue -> DegreeValue -> Bool
(DegreeValue -> DegreeValue -> Bool)
-> (DegreeValue -> DegreeValue -> Bool) -> Eq DegreeValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DegreeValue -> DegreeValue -> Bool
$c/= :: DegreeValue -> DegreeValue -> Bool
== :: DegreeValue -> DegreeValue -> Bool
$c== :: DegreeValue -> DegreeValue -> Bool
Eq,Typeable,(forall x. DegreeValue -> Rep DegreeValue x)
-> (forall x. Rep DegreeValue x -> DegreeValue)
-> Generic DegreeValue
forall x. Rep DegreeValue x -> DegreeValue
forall x. DegreeValue -> Rep DegreeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DegreeValue x -> DegreeValue
$cfrom :: forall x. DegreeValue -> Rep DegreeValue x
Generic,Int -> DegreeValue -> ShowS
[DegreeValue] -> ShowS
DegreeValue -> String
(Int -> DegreeValue -> ShowS)
-> (DegreeValue -> String)
-> ([DegreeValue] -> ShowS)
-> Show DegreeValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DegreeValue] -> ShowS
$cshowList :: [DegreeValue] -> ShowS
show :: DegreeValue -> String
$cshow :: DegreeValue -> String
showsPrec :: Int -> DegreeValue -> ShowS
$cshowsPrec :: Int -> DegreeValue -> ShowS
Show)
instance EmitXml DegreeValue where
    emitXml :: DegreeValue -> XmlRep
emitXml (DegreeValue PositiveInteger
a Maybe DegreeSymbolValue
b Maybe Token
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
a)
        ([XmlRep
-> (DegreeSymbolValue -> XmlRep)
-> Maybe DegreeSymbolValue
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"symbol" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (DegreeSymbolValue -> XmlRep) -> DegreeSymbolValue -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DegreeSymbolValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe DegreeSymbolValue
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l])
        []
parseDegreeValue :: P.XParse DegreeValue
parseDegreeValue :: XParse DegreeValue
parseDegreeValue = 
      PositiveInteger
-> Maybe DegreeSymbolValue
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeValue
DegreeValue
        (PositiveInteger
 -> Maybe DegreeSymbolValue
 -> Maybe Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> DegreeValue)
-> XParse PositiveInteger
-> XParse
     (Maybe DegreeSymbolValue
      -> Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse
  (Maybe DegreeSymbolValue
   -> Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe DegreeSymbolValue)
-> XParse
     (Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse DegreeSymbolValue -> XParse (Maybe DegreeSymbolValue)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"symbol") XParse String
-> (String -> XParse DegreeSymbolValue) -> XParse DegreeSymbolValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse DegreeSymbolValue
parseDegreeSymbolValue)
        XParse
  (Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe Token)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> DegreeValue)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> DegreeValue)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> DegreeValue)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> DegreeValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> DegreeValue)
-> XParse (Maybe Color) -> XParse DegreeValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'DegreeValue'
mkDegreeValue :: PositiveInteger -> DegreeValue
mkDegreeValue :: PositiveInteger -> DegreeValue
mkDegreeValue PositiveInteger
a = PositiveInteger
-> Maybe DegreeSymbolValue
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> DegreeValue
DegreeValue PositiveInteger
a Maybe DegreeSymbolValue
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @direction@ /(complex)/
--
-- A direction is a musical indication that is not necessarily attached to a specific note. Two or more may be combined to indicate starts and stops of wedges, dashes, etc. For applications where a specific direction is indeed attached to a specific note, the direction element can be associated with the note element that follows it in score order that is not in a different voice.
-- 
-- By default, a series of direction-type elements and a series of child elements of a direction-type within a single direction element follow one another in sequence visually. For a series of direction-type children, non-positional formatting attributes are carried over from the previous element by default.
data Direction = 
      Direction {
          Direction -> Maybe AboveBelow
directionPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Direction -> Maybe YesNo
directionDirective :: (Maybe YesNo) -- ^ /directive/ attribute
        , Direction -> Maybe ID
directionId :: (Maybe ID) -- ^ /id/ attribute
        , Direction -> [DirectionType]
directionDirectionType :: [DirectionType] -- ^ /direction-type/ child element
        , Direction -> Maybe Offset
directionOffset :: (Maybe Offset) -- ^ /offset/ child element
        , Direction -> EditorialVoiceDirection
directionEditorialVoiceDirection :: EditorialVoiceDirection
        , Direction -> Maybe Staff
directionStaff :: (Maybe Staff)
        , Direction -> Maybe Sound
directionSound :: (Maybe Sound) -- ^ /sound/ child element
       }
    deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq,Typeable,(forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic,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
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show)
instance EmitXml Direction where
    emitXml :: Direction -> XmlRep
emitXml (Direction Maybe AboveBelow
a Maybe YesNo
b Maybe ID
c [DirectionType]
d Maybe Offset
e EditorialVoiceDirection
f Maybe Staff
g Maybe Sound
h) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"directive" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
c])
        ((DirectionType -> XmlRep) -> [DirectionType] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"direction-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (DirectionType -> XmlRep) -> DirectionType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DirectionType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [DirectionType]
d [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Offset -> XmlRep) -> Maybe Offset -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"offset" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Offset -> XmlRep) -> Offset -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Offset -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Offset
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [EditorialVoiceDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EditorialVoiceDirection
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe Staff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Staff
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Sound -> XmlRep) -> Maybe Sound -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sound" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Sound -> XmlRep) -> Sound -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Sound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Sound
h])
parseDirection :: P.XParse Direction
parseDirection :: XParse Direction
parseDirection = 
      Maybe AboveBelow
-> Maybe YesNo
-> Maybe ID
-> [DirectionType]
-> Maybe Offset
-> EditorialVoiceDirection
-> Maybe Staff
-> Maybe Sound
-> Direction
Direction
        (Maybe AboveBelow
 -> Maybe YesNo
 -> Maybe ID
 -> [DirectionType]
 -> Maybe Offset
 -> EditorialVoiceDirection
 -> Maybe Staff
 -> Maybe Sound
 -> Direction)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe YesNo
      -> Maybe ID
      -> [DirectionType]
      -> Maybe Offset
      -> EditorialVoiceDirection
      -> Maybe Staff
      -> Maybe Sound
      -> Direction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe YesNo
   -> Maybe ID
   -> [DirectionType]
   -> Maybe Offset
   -> EditorialVoiceDirection
   -> Maybe Staff
   -> Maybe Sound
   -> Direction)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ID
      -> [DirectionType]
      -> Maybe Offset
      -> EditorialVoiceDirection
      -> Maybe Staff
      -> Maybe Sound
      -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"directive") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ID
   -> [DirectionType]
   -> Maybe Offset
   -> EditorialVoiceDirection
   -> Maybe Staff
   -> Maybe Sound
   -> Direction)
-> XParse (Maybe ID)
-> XParse
     ([DirectionType]
      -> Maybe Offset
      -> EditorialVoiceDirection
      -> Maybe Staff
      -> Maybe Sound
      -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  ([DirectionType]
   -> Maybe Offset
   -> EditorialVoiceDirection
   -> Maybe Staff
   -> Maybe Sound
   -> Direction)
-> XParse [DirectionType]
-> XParse
     (Maybe Offset
      -> EditorialVoiceDirection
      -> Maybe Staff
      -> Maybe Sound
      -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse DirectionType -> XParse [DirectionType]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse DirectionType -> XParse DirectionType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"direction-type") (XParse DirectionType
parseDirectionType))
        XParse
  (Maybe Offset
   -> EditorialVoiceDirection
   -> Maybe Staff
   -> Maybe Sound
   -> Direction)
-> XParse (Maybe Offset)
-> XParse
     (EditorialVoiceDirection
      -> Maybe Staff -> Maybe Sound -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Offset -> XParse (Maybe Offset)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Offset -> XParse Offset
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"offset") (XParse Offset
parseOffset))
        XParse
  (EditorialVoiceDirection
   -> Maybe Staff -> Maybe Sound -> Direction)
-> XParse EditorialVoiceDirection
-> XParse (Maybe Staff -> Maybe Sound -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EditorialVoiceDirection
parseEditorialVoiceDirection
        XParse (Maybe Staff -> Maybe Sound -> Direction)
-> XParse (Maybe Staff) -> XParse (Maybe Sound -> Direction)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Staff -> XParse (Maybe Staff)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Staff
parseStaff)
        XParse (Maybe Sound -> Direction)
-> XParse (Maybe Sound) -> XParse Direction
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Sound -> XParse (Maybe Sound)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Sound -> XParse Sound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sound") (XParse Sound
parseSound))

-- | Smart constructor for 'Direction'
mkDirection :: EditorialVoiceDirection -> Direction
mkDirection :: EditorialVoiceDirection -> Direction
mkDirection EditorialVoiceDirection
f = Maybe AboveBelow
-> Maybe YesNo
-> Maybe ID
-> [DirectionType]
-> Maybe Offset
-> EditorialVoiceDirection
-> Maybe Staff
-> Maybe Sound
-> Direction
Direction Maybe AboveBelow
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing [] Maybe Offset
forall a. Maybe a
Nothing EditorialVoiceDirection
f Maybe Staff
forall a. Maybe a
Nothing Maybe Sound
forall a. Maybe a
Nothing

-- | @direction-type@ /(complex)/
--
-- Textual direction types may have more than 1 component due to multiple fonts. The dynamics element may also be used in the notations element. Attribute groups related to print suggestions apply to the individual direction-type, not to the overall direction.
data DirectionType = 
      DirectionType {
          DirectionType -> Maybe ID
directionTypeId :: (Maybe ID) -- ^ /id/ attribute
        , DirectionType -> ChxDirectionType
directionTypeDirectionType :: ChxDirectionType
       }
    deriving (DirectionType -> DirectionType -> Bool
(DirectionType -> DirectionType -> Bool)
-> (DirectionType -> DirectionType -> Bool) -> Eq DirectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectionType -> DirectionType -> Bool
$c/= :: DirectionType -> DirectionType -> Bool
== :: DirectionType -> DirectionType -> Bool
$c== :: DirectionType -> DirectionType -> Bool
Eq,Typeable,(forall x. DirectionType -> Rep DirectionType x)
-> (forall x. Rep DirectionType x -> DirectionType)
-> Generic DirectionType
forall x. Rep DirectionType x -> DirectionType
forall x. DirectionType -> Rep DirectionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DirectionType x -> DirectionType
$cfrom :: forall x. DirectionType -> Rep DirectionType x
Generic,Int -> DirectionType -> ShowS
[DirectionType] -> ShowS
DirectionType -> String
(Int -> DirectionType -> ShowS)
-> (DirectionType -> String)
-> ([DirectionType] -> ShowS)
-> Show DirectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DirectionType] -> ShowS
$cshowList :: [DirectionType] -> ShowS
show :: DirectionType -> String
$cshow :: DirectionType -> String
showsPrec :: Int -> DirectionType -> ShowS
$cshowsPrec :: Int -> DirectionType -> ShowS
Show)
instance EmitXml DirectionType where
    emitXml :: DirectionType -> XmlRep
emitXml (DirectionType Maybe ID
a ChxDirectionType
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
a])
        ([ChxDirectionType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxDirectionType
b])
parseDirectionType :: P.XParse DirectionType
parseDirectionType :: XParse DirectionType
parseDirectionType = 
      Maybe ID -> ChxDirectionType -> DirectionType
DirectionType
        (Maybe ID -> ChxDirectionType -> DirectionType)
-> XParse (Maybe ID) -> XParse (ChxDirectionType -> DirectionType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxDirectionType -> DirectionType)
-> XParse ChxDirectionType -> XParse DirectionType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxDirectionType
parseChxDirectionType

-- | Smart constructor for 'DirectionType'
mkDirectionType :: ChxDirectionType -> DirectionType
mkDirectionType :: ChxDirectionType -> DirectionType
mkDirectionType ChxDirectionType
b = Maybe ID -> ChxDirectionType -> DirectionType
DirectionType Maybe ID
forall a. Maybe a
Nothing ChxDirectionType
b

-- | @directive@ /(complex)/
data Directive = 
      Directive {
          Directive -> String
directiveString :: String -- ^ text content
        , Directive -> Maybe Lang
directiveLang :: (Maybe Lang) -- ^ /xml:lang/ attribute
        , Directive -> Maybe Tenths
directiveDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Directive -> Maybe Tenths
directiveDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Directive -> Maybe Tenths
directiveRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Directive -> Maybe Tenths
directiveRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Directive -> Maybe CommaSeparatedText
directiveFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Directive -> Maybe FontStyle
directiveFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Directive -> Maybe FontSize
directiveFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Directive -> Maybe FontWeight
directiveFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Directive -> Maybe Color
directiveColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c== :: Directive -> Directive -> Bool
Eq,Typeable,(forall x. Directive -> Rep Directive x)
-> (forall x. Rep Directive x -> Directive) -> Generic Directive
forall x. Rep Directive x -> Directive
forall x. Directive -> Rep Directive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Directive x -> Directive
$cfrom :: forall x. Directive -> Rep Directive x
Generic,Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
(Int -> Directive -> ShowS)
-> (Directive -> String)
-> ([Directive] -> ShowS)
-> Show Directive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directive] -> ShowS
$cshowList :: [Directive] -> ShowS
show :: Directive -> String
$cshow :: Directive -> String
showsPrec :: Int -> Directive -> ShowS
$cshowsPrec :: Int -> Directive -> ShowS
Show)
instance EmitXml Directive where
    emitXml :: Directive -> XmlRep
emitXml (Directive String
a Maybe Lang
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Lang -> XmlRep) -> Maybe Lang -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Lang -> XmlRep) -> Lang -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Lang
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k])
        []
parseDirective :: P.XParse Directive
parseDirective :: XParse Directive
parseDirective = 
      String
-> Maybe Lang
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Directive
Directive
        (String
 -> Maybe Lang
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Directive)
-> XParse String
-> XParse
     (Maybe Lang
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Lang
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe Lang)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lang -> XParse (Maybe Lang)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Directive)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Directive)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Directive)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Directive)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Directive)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Directive)
-> XParse (Maybe Color) -> XParse Directive
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Directive'
mkDirective :: String -> Directive
mkDirective :: String -> Directive
mkDirective String
a = String
-> Maybe Lang
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Directive
Directive String
a Maybe Lang
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @distance@ /(complex)/
--
-- The distance element represents standard distances between notation elements in tenths. The type attribute defines what type of distance is being defined. Valid values include hyphen (for hyphens in lyrics) and beam.
data Distance = 
      Distance {
          Distance -> Tenths
distanceTenths :: Tenths -- ^ text content
        , Distance -> DistanceType
cmpdistanceType :: DistanceType -- ^ /type/ attribute
       }
    deriving (Distance -> Distance -> Bool
(Distance -> Distance -> Bool)
-> (Distance -> Distance -> Bool) -> Eq Distance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Distance -> Distance -> Bool
$c/= :: Distance -> Distance -> Bool
== :: Distance -> Distance -> Bool
$c== :: Distance -> Distance -> Bool
Eq,Typeable,(forall x. Distance -> Rep Distance x)
-> (forall x. Rep Distance x -> Distance) -> Generic Distance
forall x. Rep Distance x -> Distance
forall x. Distance -> Rep Distance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Distance x -> Distance
$cfrom :: forall x. Distance -> Rep Distance x
Generic,Int -> Distance -> ShowS
[Distance] -> ShowS
Distance -> String
(Int -> Distance -> ShowS)
-> (Distance -> String) -> ([Distance] -> ShowS) -> Show Distance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Distance] -> ShowS
$cshowList :: [Distance] -> ShowS
show :: Distance -> String
$cshow :: Distance -> String
showsPrec :: Int -> Distance -> ShowS
$cshowsPrec :: Int -> Distance -> ShowS
Show)
instance EmitXml Distance where
    emitXml :: Distance -> XmlRep
emitXml (Distance Tenths
a DistanceType
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (DistanceType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml DistanceType
b)])
        []
parseDistance :: P.XParse Distance
parseDistance :: XParse Distance
parseDistance = 
      Tenths -> DistanceType -> Distance
Distance
        (Tenths -> DistanceType -> Distance)
-> XParse Tenths -> XParse (DistanceType -> Distance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (DistanceType -> Distance)
-> XParse DistanceType -> XParse Distance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse DistanceType) -> XParse DistanceType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse DistanceType
parseDistanceType)

-- | Smart constructor for 'Distance'
mkDistance :: Tenths -> DistanceType -> Distance
mkDistance :: Tenths -> DistanceType -> Distance
mkDistance Tenths
a DistanceType
b = Tenths -> DistanceType -> Distance
Distance Tenths
a DistanceType
b

-- | @dynamics@ /(complex)/
--
-- Dynamics can be associated either with a note or a general musical direction. To avoid inconsistencies between and amongst the letter abbreviations for dynamics (what is sf vs. sfz, standing alone or with a trailing dynamic that is not always piano), we use the actual letters as the names of these dynamic elements. The other-dynamics element allows other dynamic marks that are not covered here, but many of those should perhaps be included in a more general musical direction element. Dynamics elements may also be combined to create marks not covered by a single element, such as sfmp.
-- 
-- These letter dynamic symbols are separated from crescendo, decrescendo, and wedge indications. Dynamic representation is inconsistent in scores. Many things are assumed by the composer and left out, such as returns to original dynamics. Systematic representations are quite complex: for example, Humdrum has at least 3 representation formats related to dynamics. The MusicXML format captures what is in the score, but does not try to be optimal for analysis or synthesis of dynamics.
data Dynamics = 
      Dynamics {
          Dynamics -> Maybe Tenths
dynamicsDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Dynamics -> Maybe Tenths
dynamicsDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Dynamics -> Maybe Tenths
dynamicsRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Dynamics -> Maybe Tenths
dynamicsRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Dynamics -> Maybe CommaSeparatedText
dynamicsFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Dynamics -> Maybe FontStyle
dynamicsFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Dynamics -> Maybe FontSize
dynamicsFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Dynamics -> Maybe FontWeight
dynamicsFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Dynamics -> Maybe Color
dynamicsColor :: (Maybe Color) -- ^ /color/ attribute
        , Dynamics -> Maybe LeftCenterRight
dynamicsHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Dynamics -> Maybe Valign
dynamicsValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Dynamics -> Maybe AboveBelow
dynamicsPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Dynamics -> Maybe NumberOfLines
dynamicsUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , Dynamics -> Maybe NumberOfLines
dynamicsOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , Dynamics -> Maybe NumberOfLines
dynamicsLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , Dynamics -> Maybe EnclosureShape
dynamicsEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
        , Dynamics -> Maybe ID
dynamicsId :: (Maybe ID) -- ^ /id/ attribute
        , Dynamics -> [ChxDynamics]
dynamicsDynamics :: [ChxDynamics]
       }
    deriving (Dynamics -> Dynamics -> Bool
(Dynamics -> Dynamics -> Bool)
-> (Dynamics -> Dynamics -> Bool) -> Eq Dynamics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dynamics -> Dynamics -> Bool
$c/= :: Dynamics -> Dynamics -> Bool
== :: Dynamics -> Dynamics -> Bool
$c== :: Dynamics -> Dynamics -> Bool
Eq,Typeable,(forall x. Dynamics -> Rep Dynamics x)
-> (forall x. Rep Dynamics x -> Dynamics) -> Generic Dynamics
forall x. Rep Dynamics x -> Dynamics
forall x. Dynamics -> Rep Dynamics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dynamics x -> Dynamics
$cfrom :: forall x. Dynamics -> Rep Dynamics x
Generic,Int -> Dynamics -> ShowS
[Dynamics] -> ShowS
Dynamics -> String
(Int -> Dynamics -> ShowS)
-> (Dynamics -> String) -> ([Dynamics] -> ShowS) -> Show Dynamics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dynamics] -> ShowS
$cshowList :: [Dynamics] -> ShowS
show :: Dynamics -> String
$cshow :: Dynamics -> String
showsPrec :: Int -> Dynamics -> ShowS
$cshowsPrec :: Int -> Dynamics -> ShowS
Show)
instance EmitXml Dynamics where
    emitXml :: Dynamics -> XmlRep
emitXml (Dynamics Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe LeftCenterRight
j Maybe Valign
k Maybe AboveBelow
l Maybe NumberOfLines
m Maybe NumberOfLines
n Maybe NumberOfLines
o Maybe EnclosureShape
p Maybe ID
q [ChxDynamics]
r) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
q])
        ([[ChxDynamics] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxDynamics]
r])
parseDynamics :: P.XParse Dynamics
parseDynamics :: XParse Dynamics
parseDynamics = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe AboveBelow
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe EnclosureShape
-> Maybe ID
-> [ChxDynamics]
-> Dynamics
Dynamics
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe AboveBelow
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe EnclosureShape
 -> Maybe ID
 -> [ChxDynamics]
 -> Dynamics)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe Valign)
-> XParse
     (Maybe AboveBelow
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe AboveBelow
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe EnclosureShape
      -> Maybe ID
      -> [ChxDynamics]
      -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe EnclosureShape
   -> Maybe ID
   -> [ChxDynamics]
   -> Dynamics)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe EnclosureShape -> Maybe ID -> [ChxDynamics] -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe EnclosureShape -> Maybe ID -> [ChxDynamics] -> Dynamics)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe EnclosureShape -> Maybe ID -> [ChxDynamics] -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe EnclosureShape -> Maybe ID -> [ChxDynamics] -> Dynamics)
-> XParse (Maybe EnclosureShape)
-> XParse (Maybe ID -> [ChxDynamics] -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)
        XParse (Maybe ID -> [ChxDynamics] -> Dynamics)
-> XParse (Maybe ID) -> XParse ([ChxDynamics] -> Dynamics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([ChxDynamics] -> Dynamics)
-> XParse [ChxDynamics] -> XParse Dynamics
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxDynamics -> XParse [ChxDynamics]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxDynamics
parseChxDynamics)

-- | Smart constructor for 'Dynamics'
mkDynamics :: Dynamics
mkDynamics :: Dynamics
mkDynamics = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe AboveBelow
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe EnclosureShape
-> Maybe ID
-> [ChxDynamics]
-> Dynamics
Dynamics Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing []

-- | @elision@ /(complex)/
--
-- The elision type represents an elision between lyric syllables. The text content specifies the symbol used to display the elision. Common values are a no-break space (Unicode 00A0), an underscore (Unicode 005F), or an undertie (Unicode 203F). If the text content is empty, the smufl attribute is used to specify the symbol to use. Its value is a SMuFL canonical glyph name that starts with lyrics. The SMuFL attribute is ignored if the elision glyph is already specified by the text content. If neither text content nor a smufl attribute are present, the elision glyph is application-specific.
data Elision = 
      Elision {
          Elision -> String
elisionString :: String -- ^ text content
        , Elision -> Maybe SmuflLyricsGlyphName
elisionSmufl :: (Maybe SmuflLyricsGlyphName) -- ^ /smufl/ attribute
        , Elision -> Maybe CommaSeparatedText
elisionFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Elision -> Maybe FontStyle
elisionFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Elision -> Maybe FontSize
elisionFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Elision -> Maybe FontWeight
elisionFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Elision -> Maybe Color
elisionColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Elision -> Elision -> Bool
(Elision -> Elision -> Bool)
-> (Elision -> Elision -> Bool) -> Eq Elision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elision -> Elision -> Bool
$c/= :: Elision -> Elision -> Bool
== :: Elision -> Elision -> Bool
$c== :: Elision -> Elision -> Bool
Eq,Typeable,(forall x. Elision -> Rep Elision x)
-> (forall x. Rep Elision x -> Elision) -> Generic Elision
forall x. Rep Elision x -> Elision
forall x. Elision -> Rep Elision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Elision x -> Elision
$cfrom :: forall x. Elision -> Rep Elision x
Generic,Int -> Elision -> ShowS
[Elision] -> ShowS
Elision -> String
(Int -> Elision -> ShowS)
-> (Elision -> String) -> ([Elision] -> ShowS) -> Show Elision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elision] -> ShowS
$cshowList :: [Elision] -> ShowS
show :: Elision -> String
$cshow :: Elision -> String
showsPrec :: Int -> Elision -> ShowS
$cshowsPrec :: Int -> Elision -> ShowS
Show)
instance EmitXml Elision where
    emitXml :: Elision -> XmlRep
emitXml (Elision String
a Maybe SmuflLyricsGlyphName
b Maybe CommaSeparatedText
c Maybe FontStyle
d Maybe FontSize
e Maybe FontWeight
f Maybe Color
g) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep
-> (SmuflLyricsGlyphName -> XmlRep)
-> Maybe SmuflLyricsGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflLyricsGlyphName -> XmlRep)
-> SmuflLyricsGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflLyricsGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflLyricsGlyphName
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
g])
        []
parseElision :: P.XParse Elision
parseElision :: XParse Elision
parseElision = 
      String
-> Maybe SmuflLyricsGlyphName
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Elision
Elision
        (String
 -> Maybe SmuflLyricsGlyphName
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Elision)
-> XParse String
-> XParse
     (Maybe SmuflLyricsGlyphName
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Elision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe SmuflLyricsGlyphName
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Elision)
-> XParse (Maybe SmuflLyricsGlyphName)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Elision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflLyricsGlyphName -> XParse (Maybe SmuflLyricsGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflLyricsGlyphName)
-> XParse SmuflLyricsGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflLyricsGlyphName
parseSmuflLyricsGlyphName)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Elision)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Elision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Elision)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Elision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Elision)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Elision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Elision)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Elision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Elision)
-> XParse (Maybe Color) -> XParse Elision
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Elision'
mkElision :: String -> Elision
mkElision :: String -> Elision
mkElision String
a = String
-> Maybe SmuflLyricsGlyphName
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Elision
Elision String
a Maybe SmuflLyricsGlyphName
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @empty@ /(complex)/
--
-- The empty type represents an empty element with no attributes.
data Empty = 
      Empty
    deriving (Empty -> Empty -> Bool
(Empty -> Empty -> Bool) -> (Empty -> Empty -> Bool) -> Eq Empty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Empty -> Empty -> Bool
$c/= :: Empty -> Empty -> Bool
== :: Empty -> Empty -> Bool
$c== :: Empty -> Empty -> Bool
Eq,Typeable,(forall x. Empty -> Rep Empty x)
-> (forall x. Rep Empty x -> Empty) -> Generic Empty
forall x. Rep Empty x -> Empty
forall x. Empty -> Rep Empty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Empty x -> Empty
$cfrom :: forall x. Empty -> Rep Empty x
Generic,Int -> Empty -> ShowS
[Empty] -> ShowS
Empty -> String
(Int -> Empty -> ShowS)
-> (Empty -> String) -> ([Empty] -> ShowS) -> Show Empty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Empty] -> ShowS
$cshowList :: [Empty] -> ShowS
show :: Empty -> String
$cshow :: Empty -> String
showsPrec :: Int -> Empty -> ShowS
$cshowsPrec :: Int -> Empty -> ShowS
Show)
instance EmitXml Empty where
    emitXml :: Empty -> XmlRep
emitXml (Empty
Empty) =
      [XmlRep] -> XmlRep
XReps []
parseEmpty :: P.XParse Empty
parseEmpty :: XParse Empty
parseEmpty = 
      Empty -> XParse Empty
forall (m :: * -> *) a. Monad m => a -> m a
return Empty
Empty

-- | Smart constructor for 'Empty'
mkEmpty :: Empty
mkEmpty :: Empty
mkEmpty = Empty
Empty 

-- | @empty-font@ /(complex)/
--
-- The empty-font type represents an empty element with font attributes.
data EmptyFont = 
      EmptyFont {
          EmptyFont -> Maybe CommaSeparatedText
emptyFontFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyFont -> Maybe FontStyle
emptyFontFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyFont -> Maybe FontSize
emptyFontFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyFont -> Maybe FontWeight
emptyFontFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
       }
    deriving (EmptyFont -> EmptyFont -> Bool
(EmptyFont -> EmptyFont -> Bool)
-> (EmptyFont -> EmptyFont -> Bool) -> Eq EmptyFont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyFont -> EmptyFont -> Bool
$c/= :: EmptyFont -> EmptyFont -> Bool
== :: EmptyFont -> EmptyFont -> Bool
$c== :: EmptyFont -> EmptyFont -> Bool
Eq,Typeable,(forall x. EmptyFont -> Rep EmptyFont x)
-> (forall x. Rep EmptyFont x -> EmptyFont) -> Generic EmptyFont
forall x. Rep EmptyFont x -> EmptyFont
forall x. EmptyFont -> Rep EmptyFont x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyFont x -> EmptyFont
$cfrom :: forall x. EmptyFont -> Rep EmptyFont x
Generic,Int -> EmptyFont -> ShowS
[EmptyFont] -> ShowS
EmptyFont -> String
(Int -> EmptyFont -> ShowS)
-> (EmptyFont -> String)
-> ([EmptyFont] -> ShowS)
-> Show EmptyFont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyFont] -> ShowS
$cshowList :: [EmptyFont] -> ShowS
show :: EmptyFont -> String
$cshow :: EmptyFont -> String
showsPrec :: Int -> EmptyFont -> ShowS
$cshowsPrec :: Int -> EmptyFont -> ShowS
Show)
instance EmitXml EmptyFont where
    emitXml :: EmptyFont -> XmlRep
emitXml (EmptyFont Maybe CommaSeparatedText
a Maybe FontStyle
b Maybe FontSize
c Maybe FontWeight
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
d])
        []
parseEmptyFont :: P.XParse EmptyFont
parseEmptyFont :: XParse EmptyFont
parseEmptyFont = 
      Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> EmptyFont
EmptyFont
        (Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> EmptyFont)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> EmptyFont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> EmptyFont)
-> XParse (Maybe FontStyle)
-> XParse (Maybe FontSize -> Maybe FontWeight -> EmptyFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse (Maybe FontSize -> Maybe FontWeight -> EmptyFont)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> EmptyFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> EmptyFont)
-> XParse (Maybe FontWeight) -> XParse EmptyFont
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)

-- | Smart constructor for 'EmptyFont'
mkEmptyFont :: EmptyFont
mkEmptyFont :: EmptyFont
mkEmptyFont = Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> EmptyFont
EmptyFont Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing

-- | @empty-line@ /(complex)/
--
-- The empty-line type represents an empty element with line-shape, line-type, line-length, dashed-formatting, print-style and placement attributes.
data EmptyLine = 
      EmptyLine {
          EmptyLine -> Maybe LineShape
emptyLineLineShape :: (Maybe LineShape) -- ^ /line-shape/ attribute
        , EmptyLine -> Maybe LineType
emptyLineLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , EmptyLine -> Maybe LineLength
emptyLineLineLength :: (Maybe LineLength) -- ^ /line-length/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyLine -> Maybe Tenths
emptyLineRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyLine -> Maybe CommaSeparatedText
emptyLineFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyLine -> Maybe FontStyle
emptyLineFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyLine -> Maybe FontSize
emptyLineFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyLine -> Maybe FontWeight
emptyLineFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyLine -> Maybe Color
emptyLineColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyLine -> Maybe AboveBelow
emptyLinePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (EmptyLine -> EmptyLine -> Bool
(EmptyLine -> EmptyLine -> Bool)
-> (EmptyLine -> EmptyLine -> Bool) -> Eq EmptyLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyLine -> EmptyLine -> Bool
$c/= :: EmptyLine -> EmptyLine -> Bool
== :: EmptyLine -> EmptyLine -> Bool
$c== :: EmptyLine -> EmptyLine -> Bool
Eq,Typeable,(forall x. EmptyLine -> Rep EmptyLine x)
-> (forall x. Rep EmptyLine x -> EmptyLine) -> Generic EmptyLine
forall x. Rep EmptyLine x -> EmptyLine
forall x. EmptyLine -> Rep EmptyLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyLine x -> EmptyLine
$cfrom :: forall x. EmptyLine -> Rep EmptyLine x
Generic,Int -> EmptyLine -> ShowS
[EmptyLine] -> ShowS
EmptyLine -> String
(Int -> EmptyLine -> ShowS)
-> (EmptyLine -> String)
-> ([EmptyLine] -> ShowS)
-> Show EmptyLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyLine] -> ShowS
$cshowList :: [EmptyLine] -> ShowS
show :: EmptyLine -> String
$cshow :: EmptyLine -> String
showsPrec :: Int -> EmptyLine -> ShowS
$cshowsPrec :: Int -> EmptyLine -> ShowS
Show)
instance EmitXml EmptyLine where
    emitXml :: EmptyLine -> XmlRep
emitXml (EmptyLine Maybe LineShape
a Maybe LineType
b Maybe LineLength
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe CommaSeparatedText
j Maybe FontStyle
k Maybe FontSize
l Maybe FontWeight
m Maybe Color
n Maybe AboveBelow
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (LineShape -> XmlRep) -> Maybe LineShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-shape" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineShape -> XmlRep) -> LineShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineShape
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineLength -> XmlRep) -> Maybe LineLength -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LineLength -> XmlRep) -> LineLength -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineLength -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineLength
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
o])
        []
parseEmptyLine :: P.XParse EmptyLine
parseEmptyLine :: XParse EmptyLine
parseEmptyLine = 
      Maybe LineShape
-> Maybe LineType
-> Maybe LineLength
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> EmptyLine
EmptyLine
        (Maybe LineShape
 -> Maybe LineType
 -> Maybe LineLength
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> EmptyLine)
-> XParse (Maybe LineShape)
-> XParse
     (Maybe LineType
      -> Maybe LineLength
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse LineShape -> XParse (Maybe LineShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-shape") XParse String -> (String -> XParse LineShape) -> XParse LineShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineShape
parseLineShape)
        XParse
  (Maybe LineType
   -> Maybe LineLength
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe LineType)
-> XParse
     (Maybe LineLength
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe LineLength
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe LineLength)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineLength -> XParse (Maybe LineLength)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-length") XParse String -> (String -> XParse LineLength) -> XParse LineLength
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineLength
parseLineLength)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyLine)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> EmptyLine)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> EmptyLine)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> EmptyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> EmptyLine)
-> XParse (Maybe AboveBelow) -> XParse EmptyLine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'EmptyLine'
mkEmptyLine :: EmptyLine
mkEmptyLine :: EmptyLine
mkEmptyLine = Maybe LineShape
-> Maybe LineType
-> Maybe LineLength
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> EmptyLine
EmptyLine Maybe LineShape
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe LineLength
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @empty-placement@ /(complex)/
--
-- The empty-placement type represents an empty element with print-style and placement attributes.
data EmptyPlacement = 
      EmptyPlacement {
          EmptyPlacement -> Maybe Tenths
emptyPlacementDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyPlacement -> Maybe Tenths
emptyPlacementDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyPlacement -> Maybe Tenths
emptyPlacementRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyPlacement -> Maybe Tenths
emptyPlacementRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyPlacement -> Maybe CommaSeparatedText
emptyPlacementFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyPlacement -> Maybe FontStyle
emptyPlacementFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyPlacement -> Maybe FontSize
emptyPlacementFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyPlacement -> Maybe FontWeight
emptyPlacementFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyPlacement -> Maybe Color
emptyPlacementColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyPlacement -> Maybe AboveBelow
emptyPlacementPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (EmptyPlacement -> EmptyPlacement -> Bool
(EmptyPlacement -> EmptyPlacement -> Bool)
-> (EmptyPlacement -> EmptyPlacement -> Bool) -> Eq EmptyPlacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyPlacement -> EmptyPlacement -> Bool
$c/= :: EmptyPlacement -> EmptyPlacement -> Bool
== :: EmptyPlacement -> EmptyPlacement -> Bool
$c== :: EmptyPlacement -> EmptyPlacement -> Bool
Eq,Typeable,(forall x. EmptyPlacement -> Rep EmptyPlacement x)
-> (forall x. Rep EmptyPlacement x -> EmptyPlacement)
-> Generic EmptyPlacement
forall x. Rep EmptyPlacement x -> EmptyPlacement
forall x. EmptyPlacement -> Rep EmptyPlacement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyPlacement x -> EmptyPlacement
$cfrom :: forall x. EmptyPlacement -> Rep EmptyPlacement x
Generic,Int -> EmptyPlacement -> ShowS
[EmptyPlacement] -> ShowS
EmptyPlacement -> String
(Int -> EmptyPlacement -> ShowS)
-> (EmptyPlacement -> String)
-> ([EmptyPlacement] -> ShowS)
-> Show EmptyPlacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyPlacement] -> ShowS
$cshowList :: [EmptyPlacement] -> ShowS
show :: EmptyPlacement -> String
$cshow :: EmptyPlacement -> String
showsPrec :: Int -> EmptyPlacement -> ShowS
$cshowsPrec :: Int -> EmptyPlacement -> ShowS
Show)
instance EmitXml EmptyPlacement where
    emitXml :: EmptyPlacement -> XmlRep
emitXml (EmptyPlacement Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j])
        []
parseEmptyPlacement :: P.XParse EmptyPlacement
parseEmptyPlacement :: XParse EmptyPlacement
parseEmptyPlacement = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> EmptyPlacement
EmptyPlacement
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> EmptyPlacement)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> EmptyPlacement)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe AboveBelow -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe AboveBelow -> EmptyPlacement)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> EmptyPlacement)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> EmptyPlacement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> EmptyPlacement)
-> XParse (Maybe AboveBelow) -> XParse EmptyPlacement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'EmptyPlacement'
mkEmptyPlacement :: EmptyPlacement
mkEmptyPlacement :: EmptyPlacement
mkEmptyPlacement = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> EmptyPlacement
EmptyPlacement Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @empty-placement-smufl@ /(complex)/
--
-- The empty-placement-smufl type represents an empty element with print-style, placement, and smufl attributes.
data EmptyPlacementSmufl = 
      EmptyPlacementSmufl {
          EmptyPlacementSmufl -> Maybe Tenths
emptyPlacementSmuflDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyPlacementSmufl -> Maybe Tenths
emptyPlacementSmuflDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyPlacementSmufl -> Maybe Tenths
emptyPlacementSmuflRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyPlacementSmufl -> Maybe Tenths
emptyPlacementSmuflRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyPlacementSmufl -> Maybe CommaSeparatedText
emptyPlacementSmuflFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyPlacementSmufl -> Maybe FontStyle
emptyPlacementSmuflFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyPlacementSmufl -> Maybe FontSize
emptyPlacementSmuflFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyPlacementSmufl -> Maybe FontWeight
emptyPlacementSmuflFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyPlacementSmufl -> Maybe Color
emptyPlacementSmuflColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyPlacementSmufl -> Maybe AboveBelow
emptyPlacementSmuflPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , EmptyPlacementSmufl -> Maybe SmuflGlyphName
emptyPlacementSmuflSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
       }
    deriving (EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool
(EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool)
-> (EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool)
-> Eq EmptyPlacementSmufl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool
$c/= :: EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool
== :: EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool
$c== :: EmptyPlacementSmufl -> EmptyPlacementSmufl -> Bool
Eq,Typeable,(forall x. EmptyPlacementSmufl -> Rep EmptyPlacementSmufl x)
-> (forall x. Rep EmptyPlacementSmufl x -> EmptyPlacementSmufl)
-> Generic EmptyPlacementSmufl
forall x. Rep EmptyPlacementSmufl x -> EmptyPlacementSmufl
forall x. EmptyPlacementSmufl -> Rep EmptyPlacementSmufl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyPlacementSmufl x -> EmptyPlacementSmufl
$cfrom :: forall x. EmptyPlacementSmufl -> Rep EmptyPlacementSmufl x
Generic,Int -> EmptyPlacementSmufl -> ShowS
[EmptyPlacementSmufl] -> ShowS
EmptyPlacementSmufl -> String
(Int -> EmptyPlacementSmufl -> ShowS)
-> (EmptyPlacementSmufl -> String)
-> ([EmptyPlacementSmufl] -> ShowS)
-> Show EmptyPlacementSmufl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyPlacementSmufl] -> ShowS
$cshowList :: [EmptyPlacementSmufl] -> ShowS
show :: EmptyPlacementSmufl -> String
$cshow :: EmptyPlacementSmufl -> String
showsPrec :: Int -> EmptyPlacementSmufl -> ShowS
$cshowsPrec :: Int -> EmptyPlacementSmufl -> ShowS
Show)
instance EmitXml EmptyPlacementSmufl where
    emitXml :: EmptyPlacementSmufl -> XmlRep
emitXml (EmptyPlacementSmufl Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j Maybe SmuflGlyphName
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
k])
        []
parseEmptyPlacementSmufl :: P.XParse EmptyPlacementSmufl
parseEmptyPlacementSmufl :: XParse EmptyPlacementSmufl
parseEmptyPlacementSmufl = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> EmptyPlacementSmufl
EmptyPlacementSmufl
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe SmuflGlyphName
 -> EmptyPlacementSmufl)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> EmptyPlacementSmufl)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow -> Maybe SmuflGlyphName -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow -> Maybe SmuflGlyphName -> EmptyPlacementSmufl)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow -> Maybe SmuflGlyphName -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow -> Maybe SmuflGlyphName -> EmptyPlacementSmufl)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe SmuflGlyphName -> EmptyPlacementSmufl)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe SmuflGlyphName -> EmptyPlacementSmufl)
-> XParse (Maybe SmuflGlyphName) -> XParse EmptyPlacementSmufl
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)

-- | Smart constructor for 'EmptyPlacementSmufl'
mkEmptyPlacementSmufl :: EmptyPlacementSmufl
mkEmptyPlacementSmufl :: EmptyPlacementSmufl
mkEmptyPlacementSmufl = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> EmptyPlacementSmufl
EmptyPlacementSmufl Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing

-- | @empty-print-object-style-align@ /(complex)/
--
-- The empty-print-style-align-object type represents an empty element with print-object and print-style-align attribute groups.
data EmptyPrintObjectStyleAlign = 
      EmptyPrintObjectStyleAlign {
          EmptyPrintObjectStyleAlign -> Maybe YesNo
emptyPrintObjectStyleAlignPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Tenths
emptyPrintObjectStyleAlignDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Tenths
emptyPrintObjectStyleAlignDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Tenths
emptyPrintObjectStyleAlignRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Tenths
emptyPrintObjectStyleAlignRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe CommaSeparatedText
emptyPrintObjectStyleAlignFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe FontStyle
emptyPrintObjectStyleAlignFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe FontSize
emptyPrintObjectStyleAlignFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe FontWeight
emptyPrintObjectStyleAlignFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Color
emptyPrintObjectStyleAlignColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe LeftCenterRight
emptyPrintObjectStyleAlignHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , EmptyPrintObjectStyleAlign -> Maybe Valign
emptyPrintObjectStyleAlignValign :: (Maybe Valign) -- ^ /valign/ attribute
       }
    deriving (EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool
(EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool)
-> (EmptyPrintObjectStyleAlign
    -> EmptyPrintObjectStyleAlign -> Bool)
-> Eq EmptyPrintObjectStyleAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool
$c/= :: EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool
== :: EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool
$c== :: EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> Bool
Eq,Typeable,(forall x.
 EmptyPrintObjectStyleAlign -> Rep EmptyPrintObjectStyleAlign x)
-> (forall x.
    Rep EmptyPrintObjectStyleAlign x -> EmptyPrintObjectStyleAlign)
-> Generic EmptyPrintObjectStyleAlign
forall x.
Rep EmptyPrintObjectStyleAlign x -> EmptyPrintObjectStyleAlign
forall x.
EmptyPrintObjectStyleAlign -> Rep EmptyPrintObjectStyleAlign x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep EmptyPrintObjectStyleAlign x -> EmptyPrintObjectStyleAlign
$cfrom :: forall x.
EmptyPrintObjectStyleAlign -> Rep EmptyPrintObjectStyleAlign x
Generic,Int -> EmptyPrintObjectStyleAlign -> ShowS
[EmptyPrintObjectStyleAlign] -> ShowS
EmptyPrintObjectStyleAlign -> String
(Int -> EmptyPrintObjectStyleAlign -> ShowS)
-> (EmptyPrintObjectStyleAlign -> String)
-> ([EmptyPrintObjectStyleAlign] -> ShowS)
-> Show EmptyPrintObjectStyleAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyPrintObjectStyleAlign] -> ShowS
$cshowList :: [EmptyPrintObjectStyleAlign] -> ShowS
show :: EmptyPrintObjectStyleAlign -> String
$cshow :: EmptyPrintObjectStyleAlign -> String
showsPrec :: Int -> EmptyPrintObjectStyleAlign -> ShowS
$cshowsPrec :: Int -> EmptyPrintObjectStyleAlign -> ShowS
Show)
instance EmitXml EmptyPrintObjectStyleAlign where
    emitXml :: EmptyPrintObjectStyleAlign -> XmlRep
emitXml (EmptyPrintObjectStyleAlign Maybe YesNo
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l])
        []
parseEmptyPrintObjectStyleAlign :: P.XParse EmptyPrintObjectStyleAlign
parseEmptyPrintObjectStyleAlign :: XParse EmptyPrintObjectStyleAlign
parseEmptyPrintObjectStyleAlign = 
      Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> EmptyPrintObjectStyleAlign
EmptyPrintObjectStyleAlign
        (Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> EmptyPrintObjectStyleAlign)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> EmptyPrintObjectStyleAlign)
-> XParse (Maybe Valign) -> XParse EmptyPrintObjectStyleAlign
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)

-- | Smart constructor for 'EmptyPrintObjectStyleAlign'
mkEmptyPrintObjectStyleAlign :: EmptyPrintObjectStyleAlign
mkEmptyPrintObjectStyleAlign :: EmptyPrintObjectStyleAlign
mkEmptyPrintObjectStyleAlign = Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> EmptyPrintObjectStyleAlign
EmptyPrintObjectStyleAlign Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing

-- | @empty-print-style-align-id@ /(complex)/
--
-- The empty-print-style-align-id type represents an empty element with print-style-align and optional-unique-id attribute groups.
data EmptyPrintStyleAlignId = 
      EmptyPrintStyleAlignId {
          EmptyPrintStyleAlignId -> Maybe Tenths
emptyPrintStyleAlignIdDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyPrintStyleAlignId -> Maybe Tenths
emptyPrintStyleAlignIdDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyPrintStyleAlignId -> Maybe Tenths
emptyPrintStyleAlignIdRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyPrintStyleAlignId -> Maybe Tenths
emptyPrintStyleAlignIdRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyPrintStyleAlignId -> Maybe CommaSeparatedText
emptyPrintStyleAlignIdFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyPrintStyleAlignId -> Maybe FontStyle
emptyPrintStyleAlignIdFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyPrintStyleAlignId -> Maybe FontSize
emptyPrintStyleAlignIdFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyPrintStyleAlignId -> Maybe FontWeight
emptyPrintStyleAlignIdFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyPrintStyleAlignId -> Maybe Color
emptyPrintStyleAlignIdColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyPrintStyleAlignId -> Maybe LeftCenterRight
emptyPrintStyleAlignIdHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , EmptyPrintStyleAlignId -> Maybe Valign
emptyPrintStyleAlignIdValign :: (Maybe Valign) -- ^ /valign/ attribute
        , EmptyPrintStyleAlignId -> Maybe ID
emptyPrintStyleAlignIdId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool
(EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool)
-> (EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool)
-> Eq EmptyPrintStyleAlignId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool
$c/= :: EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool
== :: EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool
$c== :: EmptyPrintStyleAlignId -> EmptyPrintStyleAlignId -> Bool
Eq,Typeable,(forall x. EmptyPrintStyleAlignId -> Rep EmptyPrintStyleAlignId x)
-> (forall x.
    Rep EmptyPrintStyleAlignId x -> EmptyPrintStyleAlignId)
-> Generic EmptyPrintStyleAlignId
forall x. Rep EmptyPrintStyleAlignId x -> EmptyPrintStyleAlignId
forall x. EmptyPrintStyleAlignId -> Rep EmptyPrintStyleAlignId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyPrintStyleAlignId x -> EmptyPrintStyleAlignId
$cfrom :: forall x. EmptyPrintStyleAlignId -> Rep EmptyPrintStyleAlignId x
Generic,Int -> EmptyPrintStyleAlignId -> ShowS
[EmptyPrintStyleAlignId] -> ShowS
EmptyPrintStyleAlignId -> String
(Int -> EmptyPrintStyleAlignId -> ShowS)
-> (EmptyPrintStyleAlignId -> String)
-> ([EmptyPrintStyleAlignId] -> ShowS)
-> Show EmptyPrintStyleAlignId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyPrintStyleAlignId] -> ShowS
$cshowList :: [EmptyPrintStyleAlignId] -> ShowS
show :: EmptyPrintStyleAlignId -> String
$cshow :: EmptyPrintStyleAlignId -> String
showsPrec :: Int -> EmptyPrintStyleAlignId -> ShowS
$cshowsPrec :: Int -> EmptyPrintStyleAlignId -> ShowS
Show)
instance EmitXml EmptyPrintStyleAlignId where
    emitXml :: EmptyPrintStyleAlignId -> XmlRep
emitXml (EmptyPrintStyleAlignId Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe LeftCenterRight
j Maybe Valign
k Maybe ID
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        []
parseEmptyPrintStyleAlignId :: P.XParse EmptyPrintStyleAlignId
parseEmptyPrintStyleAlignId :: XParse EmptyPrintStyleAlignId
parseEmptyPrintStyleAlignId = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> EmptyPrintStyleAlignId
EmptyPrintStyleAlignId
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> EmptyPrintStyleAlignId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> EmptyPrintStyleAlignId)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign -> Maybe ID -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign -> Maybe ID -> EmptyPrintStyleAlignId)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> EmptyPrintStyleAlignId)
-> XParse (Maybe Valign)
-> XParse (Maybe ID -> EmptyPrintStyleAlignId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> EmptyPrintStyleAlignId)
-> XParse (Maybe ID) -> XParse EmptyPrintStyleAlignId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'EmptyPrintStyleAlignId'
mkEmptyPrintStyleAlignId :: EmptyPrintStyleAlignId
mkEmptyPrintStyleAlignId :: EmptyPrintStyleAlignId
mkEmptyPrintStyleAlignId = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> EmptyPrintStyleAlignId
EmptyPrintStyleAlignId Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @empty-trill-sound@ /(complex)/
--
-- The empty-trill-sound type represents an empty element with print-style, placement, and trill-sound attributes.
data EmptyTrillSound = 
      EmptyTrillSound {
          EmptyTrillSound -> Maybe Tenths
emptyTrillSoundDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , EmptyTrillSound -> Maybe Tenths
emptyTrillSoundDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , EmptyTrillSound -> Maybe Tenths
emptyTrillSoundRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , EmptyTrillSound -> Maybe Tenths
emptyTrillSoundRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , EmptyTrillSound -> Maybe CommaSeparatedText
emptyTrillSoundFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , EmptyTrillSound -> Maybe FontStyle
emptyTrillSoundFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , EmptyTrillSound -> Maybe FontSize
emptyTrillSoundFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , EmptyTrillSound -> Maybe FontWeight
emptyTrillSoundFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , EmptyTrillSound -> Maybe Color
emptyTrillSoundColor :: (Maybe Color) -- ^ /color/ attribute
        , EmptyTrillSound -> Maybe AboveBelow
emptyTrillSoundPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , EmptyTrillSound -> Maybe StartNote
emptyTrillSoundStartNote :: (Maybe StartNote) -- ^ /start-note/ attribute
        , EmptyTrillSound -> Maybe TrillStep
emptyTrillSoundTrillStep :: (Maybe TrillStep) -- ^ /trill-step/ attribute
        , EmptyTrillSound -> Maybe TwoNoteTurn
emptyTrillSoundTwoNoteTurn :: (Maybe TwoNoteTurn) -- ^ /two-note-turn/ attribute
        , EmptyTrillSound -> Maybe YesNo
emptyTrillSoundAccelerate :: (Maybe YesNo) -- ^ /accelerate/ attribute
        , EmptyTrillSound -> Maybe TrillBeats
emptyTrillSoundBeats :: (Maybe TrillBeats) -- ^ /beats/ attribute
        , EmptyTrillSound -> Maybe Percent
emptyTrillSoundSecondBeat :: (Maybe Percent) -- ^ /second-beat/ attribute
        , EmptyTrillSound -> Maybe Percent
emptyTrillSoundLastBeat :: (Maybe Percent) -- ^ /last-beat/ attribute
       }
    deriving (EmptyTrillSound -> EmptyTrillSound -> Bool
(EmptyTrillSound -> EmptyTrillSound -> Bool)
-> (EmptyTrillSound -> EmptyTrillSound -> Bool)
-> Eq EmptyTrillSound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyTrillSound -> EmptyTrillSound -> Bool
$c/= :: EmptyTrillSound -> EmptyTrillSound -> Bool
== :: EmptyTrillSound -> EmptyTrillSound -> Bool
$c== :: EmptyTrillSound -> EmptyTrillSound -> Bool
Eq,Typeable,(forall x. EmptyTrillSound -> Rep EmptyTrillSound x)
-> (forall x. Rep EmptyTrillSound x -> EmptyTrillSound)
-> Generic EmptyTrillSound
forall x. Rep EmptyTrillSound x -> EmptyTrillSound
forall x. EmptyTrillSound -> Rep EmptyTrillSound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmptyTrillSound x -> EmptyTrillSound
$cfrom :: forall x. EmptyTrillSound -> Rep EmptyTrillSound x
Generic,Int -> EmptyTrillSound -> ShowS
[EmptyTrillSound] -> ShowS
EmptyTrillSound -> String
(Int -> EmptyTrillSound -> ShowS)
-> (EmptyTrillSound -> String)
-> ([EmptyTrillSound] -> ShowS)
-> Show EmptyTrillSound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyTrillSound] -> ShowS
$cshowList :: [EmptyTrillSound] -> ShowS
show :: EmptyTrillSound -> String
$cshow :: EmptyTrillSound -> String
showsPrec :: Int -> EmptyTrillSound -> ShowS
$cshowsPrec :: Int -> EmptyTrillSound -> ShowS
Show)
instance EmitXml EmptyTrillSound where
    emitXml :: EmptyTrillSound -> XmlRep
emitXml (EmptyTrillSound Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j Maybe StartNote
k Maybe TrillStep
l Maybe TwoNoteTurn
m Maybe YesNo
n Maybe TrillBeats
o Maybe Percent
p Maybe Percent
q) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StartNote -> XmlRep) -> Maybe StartNote -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"start-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StartNote -> XmlRep) -> StartNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StartNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StartNote
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillStep -> XmlRep) -> Maybe TrillStep -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"trill-step" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TrillStep -> XmlRep) -> TrillStep -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillStep -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillStep
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TwoNoteTurn -> XmlRep) -> Maybe TwoNoteTurn -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"two-note-turn" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TwoNoteTurn -> XmlRep) -> TwoNoteTurn -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TwoNoteTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TwoNoteTurn
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"accelerate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillBeats -> XmlRep) -> Maybe TrillBeats -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TrillBeats -> XmlRep) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillBeats -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillBeats
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"second-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"last-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
q])
        []
parseEmptyTrillSound :: P.XParse EmptyTrillSound
parseEmptyTrillSound :: XParse EmptyTrillSound
parseEmptyTrillSound = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> EmptyTrillSound
EmptyTrillSound
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe StartNote
 -> Maybe TrillStep
 -> Maybe TwoNoteTurn
 -> Maybe YesNo
 -> Maybe TrillBeats
 -> Maybe Percent
 -> Maybe Percent
 -> EmptyTrillSound)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe StartNote)
-> XParse
     (Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StartNote -> XParse (Maybe StartNote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"start-note") XParse String -> (String -> XParse StartNote) -> XParse StartNote
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartNote
parseStartNote)
        XParse
  (Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe TrillStep)
-> XParse
     (Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillStep -> XParse (Maybe TrillStep)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"trill-step") XParse String -> (String -> XParse TrillStep) -> XParse TrillStep
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillStep
parseTrillStep)
        XParse
  (Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe TwoNoteTurn)
-> XParse
     (Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TwoNoteTurn -> XParse (Maybe TwoNoteTurn)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"two-note-turn") XParse String
-> (String -> XParse TwoNoteTurn) -> XParse TwoNoteTurn
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TwoNoteTurn
parseTwoNoteTurn)
        XParse
  (Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> EmptyTrillSound)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe TrillBeats
      -> Maybe Percent -> Maybe Percent -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"accelerate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe TrillBeats
   -> Maybe Percent -> Maybe Percent -> EmptyTrillSound)
-> XParse (Maybe TrillBeats)
-> XParse (Maybe Percent -> Maybe Percent -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillBeats -> XParse (Maybe TrillBeats)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"beats") XParse String -> (String -> XParse TrillBeats) -> XParse TrillBeats
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillBeats
parseTrillBeats)
        XParse (Maybe Percent -> Maybe Percent -> EmptyTrillSound)
-> XParse (Maybe Percent)
-> XParse (Maybe Percent -> EmptyTrillSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"second-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Percent -> EmptyTrillSound)
-> XParse (Maybe Percent) -> XParse EmptyTrillSound
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"last-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)

-- | Smart constructor for 'EmptyTrillSound'
mkEmptyTrillSound :: EmptyTrillSound
mkEmptyTrillSound :: EmptyTrillSound
mkEmptyTrillSound = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> EmptyTrillSound
EmptyTrillSound Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe StartNote
forall a. Maybe a
Nothing Maybe TrillStep
forall a. Maybe a
Nothing Maybe TwoNoteTurn
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe TrillBeats
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing

-- | @encoding@ /(complex)/
--
-- The encoding element contains information about who did the digital encoding, when, with what software, and in what aspects. Standard type values for the encoder element are music, words, and arrangement, but other types may be used. The type attribute is only needed when there are multiple encoder elements.
data Encoding = 
      Encoding {
          Encoding -> [ChxEncoding]
encodingEncoding :: [ChxEncoding]
       }
    deriving (Encoding -> Encoding -> Bool
(Encoding -> Encoding -> Bool)
-> (Encoding -> Encoding -> Bool) -> Eq Encoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encoding -> Encoding -> Bool
$c/= :: Encoding -> Encoding -> Bool
== :: Encoding -> Encoding -> Bool
$c== :: Encoding -> Encoding -> Bool
Eq,Typeable,(forall x. Encoding -> Rep Encoding x)
-> (forall x. Rep Encoding x -> Encoding) -> Generic Encoding
forall x. Rep Encoding x -> Encoding
forall x. Encoding -> Rep Encoding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Encoding x -> Encoding
$cfrom :: forall x. Encoding -> Rep Encoding x
Generic,Int -> Encoding -> ShowS
[Encoding] -> ShowS
Encoding -> String
(Int -> Encoding -> ShowS)
-> (Encoding -> String) -> ([Encoding] -> ShowS) -> Show Encoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Encoding] -> ShowS
$cshowList :: [Encoding] -> ShowS
show :: Encoding -> String
$cshow :: Encoding -> String
showsPrec :: Int -> Encoding -> ShowS
$cshowsPrec :: Int -> Encoding -> ShowS
Show)
instance EmitXml Encoding where
    emitXml :: Encoding -> XmlRep
emitXml (Encoding [ChxEncoding]
a) =
      [XmlRep] -> XmlRep
XReps [[ChxEncoding] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxEncoding]
a]
parseEncoding :: P.XParse Encoding
parseEncoding :: XParse Encoding
parseEncoding = 
      [ChxEncoding] -> Encoding
Encoding
        ([ChxEncoding] -> Encoding)
-> XParse [ChxEncoding] -> XParse Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxEncoding -> XParse [ChxEncoding]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxEncoding
parseChxEncoding)

-- | Smart constructor for 'Encoding'
mkEncoding :: Encoding
mkEncoding :: Encoding
mkEncoding = [ChxEncoding] -> Encoding
Encoding []

-- | @ending@ /(complex)/
--
-- The ending type represents multiple (e.g. first and second) endings. Typically, the start type is associated with the left barline of the first measure in an ending. The stop and discontinue types are associated with the right barline of the last measure in an ending. Stop is used when the ending mark concludes with a downward jog, as is typical for first endings. Discontinue is used when there is no downward jog, as is typical for second endings that do not conclude a piece. The length of the jog can be specified using the end-length attribute. The text-x and text-y attributes are offsets that specify where the baseline of the start of the ending text appears, relative to the start of the ending line.
-- 
-- The number attribute reflects the numeric values of what is under the ending line. Single endings such as "1" or comma-separated multiple endings such as "1,2" may be used. The ending element text is used when the text displayed in the ending is different than what appears in the number attribute. The print-object element is used to indicate when an ending is present but not printed, as is often the case for many parts in a full score.
data Ending = 
      Ending {
          Ending -> String
endingString :: String -- ^ text content
        , Ending -> EndingNumber
cmpendingNumber :: EndingNumber -- ^ /number/ attribute
        , Ending -> StartStopDiscontinue
endingType :: StartStopDiscontinue -- ^ /type/ attribute
        , Ending -> Maybe Tenths
endingEndLength :: (Maybe Tenths) -- ^ /end-length/ attribute
        , Ending -> Maybe Tenths
endingTextX :: (Maybe Tenths) -- ^ /text-x/ attribute
        , Ending -> Maybe Tenths
endingTextY :: (Maybe Tenths) -- ^ /text-y/ attribute
        , Ending -> Maybe YesNo
endingPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Ending -> Maybe Tenths
endingDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Ending -> Maybe Tenths
endingDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Ending -> Maybe Tenths
endingRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Ending -> Maybe Tenths
endingRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Ending -> Maybe CommaSeparatedText
endingFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Ending -> Maybe FontStyle
endingFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Ending -> Maybe FontSize
endingFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Ending -> Maybe FontWeight
endingFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Ending -> Maybe Color
endingColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Ending -> Ending -> Bool
(Ending -> Ending -> Bool)
-> (Ending -> Ending -> Bool) -> Eq Ending
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ending -> Ending -> Bool
$c/= :: Ending -> Ending -> Bool
== :: Ending -> Ending -> Bool
$c== :: Ending -> Ending -> Bool
Eq,Typeable,(forall x. Ending -> Rep Ending x)
-> (forall x. Rep Ending x -> Ending) -> Generic Ending
forall x. Rep Ending x -> Ending
forall x. Ending -> Rep Ending x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ending x -> Ending
$cfrom :: forall x. Ending -> Rep Ending x
Generic,Int -> Ending -> ShowS
[Ending] -> ShowS
Ending -> String
(Int -> Ending -> ShowS)
-> (Ending -> String) -> ([Ending] -> ShowS) -> Show Ending
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ending] -> ShowS
$cshowList :: [Ending] -> ShowS
show :: Ending -> String
$cshow :: Ending -> String
showsPrec :: Int -> Ending -> ShowS
$cshowsPrec :: Int -> Ending -> ShowS
Show)
instance EmitXml Ending where
    emitXml :: Ending -> XmlRep
emitXml (Ending String
a EndingNumber
b StartStopDiscontinue
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe YesNo
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe Tenths
k Maybe CommaSeparatedText
l Maybe FontStyle
m Maybe FontSize
n Maybe FontWeight
o Maybe Color
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing) (EndingNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EndingNumber
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopDiscontinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopDiscontinue
c)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"end-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
p])
        []
parseEnding :: P.XParse Ending
parseEnding :: XParse Ending
parseEnding = 
      String
-> EndingNumber
-> StartStopDiscontinue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Ending
Ending
        (String
 -> EndingNumber
 -> StartStopDiscontinue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Ending)
-> XParse String
-> XParse
     (EndingNumber
      -> StartStopDiscontinue
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (EndingNumber
   -> StartStopDiscontinue
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse EndingNumber
-> XParse
     (StartStopDiscontinue
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse EndingNumber) -> XParse EndingNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EndingNumber
parseEndingNumber)
        XParse
  (StartStopDiscontinue
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse StartStopDiscontinue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopDiscontinue)
-> XParse StartStopDiscontinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopDiscontinue
parseStartStopDiscontinue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"end-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Ending)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Ending)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Ending)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Ending)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Ending)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Ending)
-> XParse (Maybe Color) -> XParse Ending
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Ending'
mkEnding :: String -> EndingNumber -> StartStopDiscontinue -> Ending
mkEnding :: String -> EndingNumber -> StartStopDiscontinue -> Ending
mkEnding String
a EndingNumber
b StartStopDiscontinue
c = String
-> EndingNumber
-> StartStopDiscontinue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Ending
Ending String
a EndingNumber
b StartStopDiscontinue
c Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @extend@ /(complex)/
--
-- The extend type represents lyric word extension / melisma lines as well as figured bass extensions. The optional type and position attributes are added in Version 3.0 to provide better formatting control.
data Extend = 
      Extend {
          Extend -> Maybe StartStopContinue
extendType :: (Maybe StartStopContinue) -- ^ /type/ attribute
        , Extend -> Maybe Tenths
extendDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Extend -> Maybe Tenths
extendDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Extend -> Maybe Tenths
extendRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Extend -> Maybe Tenths
extendRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Extend -> Maybe Color
extendColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Extend -> Extend -> Bool
(Extend -> Extend -> Bool)
-> (Extend -> Extend -> Bool) -> Eq Extend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Extend -> Extend -> Bool
$c/= :: Extend -> Extend -> Bool
== :: Extend -> Extend -> Bool
$c== :: Extend -> Extend -> Bool
Eq,Typeable,(forall x. Extend -> Rep Extend x)
-> (forall x. Rep Extend x -> Extend) -> Generic Extend
forall x. Rep Extend x -> Extend
forall x. Extend -> Rep Extend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Extend x -> Extend
$cfrom :: forall x. Extend -> Rep Extend x
Generic,Int -> Extend -> ShowS
[Extend] -> ShowS
Extend -> String
(Int -> Extend -> ShowS)
-> (Extend -> String) -> ([Extend] -> ShowS) -> Show Extend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extend] -> ShowS
$cshowList :: [Extend] -> ShowS
show :: Extend -> String
$cshow :: Extend -> String
showsPrec :: Int -> Extend -> ShowS
$cshowsPrec :: Int -> Extend -> ShowS
Show)
instance EmitXml Extend where
    emitXml :: Extend -> XmlRep
emitXml (Extend Maybe StartStopContinue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (StartStopContinue -> XmlRep)
-> Maybe StartStopContinue
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StartStopContinue -> XmlRep) -> StartStopContinue -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StartStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StartStopContinue
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseExtend :: P.XParse Extend
parseExtend :: XParse Extend
parseExtend = 
      Maybe StartStopContinue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Extend
Extend
        (Maybe StartStopContinue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Extend)
-> XParse (Maybe StartStopContinue)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Extend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StartStopContinue -> XParse (Maybe StartStopContinue)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopContinue) -> XParse StartStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopContinue
parseStartStopContinue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Extend)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> Extend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> Extend)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Extend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Extend)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> Extend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> Extend)
-> XParse (Maybe Tenths) -> XParse (Maybe Color -> Extend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> Extend)
-> XParse (Maybe Color) -> XParse Extend
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Extend'
mkExtend :: Extend
mkExtend :: Extend
mkExtend = Maybe StartStopContinue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Extend
Extend Maybe StartStopContinue
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @feature@ /(complex)/
--
-- The feature type is a part of the grouping element used for musical analysis. The type attribute represents the type of the feature and the element content represents its value. This type is flexible to allow for different analyses.
data Feature = 
      Feature {
          Feature -> String
featureString :: String -- ^ text content
        , Feature -> Maybe Token
featureType :: (Maybe Token) -- ^ /type/ attribute
       }
    deriving (Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c== :: Feature -> Feature -> Bool
Eq,Typeable,(forall x. Feature -> Rep Feature x)
-> (forall x. Rep Feature x -> Feature) -> Generic Feature
forall x. Rep Feature x -> Feature
forall x. Feature -> Rep Feature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Feature x -> Feature
$cfrom :: forall x. Feature -> Rep Feature x
Generic,Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feature] -> ShowS
$cshowList :: [Feature] -> ShowS
show :: Feature -> String
$cshow :: Feature -> String
showsPrec :: Int -> Feature -> ShowS
$cshowsPrec :: Int -> Feature -> ShowS
Show)
instance EmitXml Feature where
    emitXml :: Feature -> XmlRep
emitXml (Feature String
a Maybe Token
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b])
        []
parseFeature :: P.XParse Feature
parseFeature :: XParse Feature
parseFeature = 
      String -> Maybe Token -> Feature
Feature
        (String -> Maybe Token -> Feature)
-> XParse String -> XParse (Maybe Token -> Feature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Maybe Token -> Feature)
-> XParse (Maybe Token) -> XParse Feature
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'Feature'
mkFeature :: String -> Feature
mkFeature :: String -> Feature
mkFeature String
a = String -> Maybe Token -> Feature
Feature String
a Maybe Token
forall a. Maybe a
Nothing

-- | @fermata@ /(complex)/
--
-- The fermata text content represents the shape of the fermata sign. An empty fermata element represents a normal fermata. The fermata type is upright if not specified.
data Fermata = 
      Fermata {
          Fermata -> FermataShape
fermataFermataShape :: FermataShape -- ^ text content
        , Fermata -> Maybe UprightInverted
fermataType :: (Maybe UprightInverted) -- ^ /type/ attribute
        , Fermata -> Maybe Tenths
fermataDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Fermata -> Maybe Tenths
fermataDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Fermata -> Maybe Tenths
fermataRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Fermata -> Maybe Tenths
fermataRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Fermata -> Maybe CommaSeparatedText
fermataFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Fermata -> Maybe FontStyle
fermataFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Fermata -> Maybe FontSize
fermataFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Fermata -> Maybe FontWeight
fermataFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Fermata -> Maybe Color
fermataColor :: (Maybe Color) -- ^ /color/ attribute
        , Fermata -> Maybe ID
fermataId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Fermata -> Fermata -> Bool
(Fermata -> Fermata -> Bool)
-> (Fermata -> Fermata -> Bool) -> Eq Fermata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fermata -> Fermata -> Bool
$c/= :: Fermata -> Fermata -> Bool
== :: Fermata -> Fermata -> Bool
$c== :: Fermata -> Fermata -> Bool
Eq,Typeable,(forall x. Fermata -> Rep Fermata x)
-> (forall x. Rep Fermata x -> Fermata) -> Generic Fermata
forall x. Rep Fermata x -> Fermata
forall x. Fermata -> Rep Fermata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fermata x -> Fermata
$cfrom :: forall x. Fermata -> Rep Fermata x
Generic,Int -> Fermata -> ShowS
[Fermata] -> ShowS
Fermata -> String
(Int -> Fermata -> ShowS)
-> (Fermata -> String) -> ([Fermata] -> ShowS) -> Show Fermata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fermata] -> ShowS
$cshowList :: [Fermata] -> ShowS
show :: Fermata -> String
$cshow :: Fermata -> String
showsPrec :: Int -> Fermata -> ShowS
$cshowsPrec :: Int -> Fermata -> ShowS
Show)
instance EmitXml Fermata where
    emitXml :: Fermata -> XmlRep
emitXml (Fermata FermataShape
a Maybe UprightInverted
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k Maybe ID
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (FermataShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FermataShape
a)
        ([XmlRep
-> (UprightInverted -> XmlRep) -> Maybe UprightInverted -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (UprightInverted -> XmlRep) -> UprightInverted -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UprightInverted -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe UprightInverted
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        []
parseFermata :: P.XParse Fermata
parseFermata :: XParse Fermata
parseFermata = 
      FermataShape
-> Maybe UprightInverted
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> Fermata
Fermata
        (FermataShape
 -> Maybe UprightInverted
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe ID
 -> Fermata)
-> XParse FermataShape
-> XParse
     (Maybe UprightInverted
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse FermataShape) -> XParse FermataShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FermataShape
parseFermataShape)
        XParse
  (Maybe UprightInverted
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe UprightInverted)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse UprightInverted -> XParse (Maybe UprightInverted)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse UprightInverted) -> XParse UprightInverted
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse UprightInverted
parseUprightInverted)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Fermata)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe ID -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe ID -> Fermata)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Maybe ID -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Maybe ID -> Fermata)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe ID -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe ID -> Fermata)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Fermata)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Fermata) -> XParse (Maybe ID) -> XParse Fermata
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Fermata'
mkFermata :: FermataShape -> Fermata
mkFermata :: FermataShape -> Fermata
mkFermata FermataShape
a = FermataShape
-> Maybe UprightInverted
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> Fermata
Fermata FermataShape
a Maybe UprightInverted
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @figure@ /(complex)/
--
-- The figure type represents a single figure within a figured-bass element.
data Figure = 
      Figure {
          Figure -> Maybe StyleText
figurePrefix :: (Maybe StyleText) -- ^ /prefix/ child element
        , Figure -> Maybe StyleText
figureFigureNumber :: (Maybe StyleText) -- ^ /figure-number/ child element
        , Figure -> Maybe StyleText
figureSuffix :: (Maybe StyleText) -- ^ /suffix/ child element
        , Figure -> Maybe Extend
figureExtend :: (Maybe Extend) -- ^ /extend/ child element
        , Figure -> Editorial
figureEditorial :: Editorial
       }
    deriving (Figure -> Figure -> Bool
(Figure -> Figure -> Bool)
-> (Figure -> Figure -> Bool) -> Eq Figure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Figure -> Figure -> Bool
$c/= :: Figure -> Figure -> Bool
== :: Figure -> Figure -> Bool
$c== :: Figure -> Figure -> Bool
Eq,Typeable,(forall x. Figure -> Rep Figure x)
-> (forall x. Rep Figure x -> Figure) -> Generic Figure
forall x. Rep Figure x -> Figure
forall x. Figure -> Rep Figure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Figure x -> Figure
$cfrom :: forall x. Figure -> Rep Figure x
Generic,Int -> Figure -> ShowS
[Figure] -> ShowS
Figure -> String
(Int -> Figure -> ShowS)
-> (Figure -> String) -> ([Figure] -> ShowS) -> Show Figure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Figure] -> ShowS
$cshowList :: [Figure] -> ShowS
show :: Figure -> String
$cshow :: Figure -> String
showsPrec :: Int -> Figure -> ShowS
$cshowsPrec :: Int -> Figure -> ShowS
Show)
instance EmitXml Figure where
    emitXml :: Figure -> XmlRep
emitXml (Figure Maybe StyleText
a Maybe StyleText
b Maybe StyleText
c Maybe Extend
d Editorial
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (StyleText -> XmlRep) -> Maybe StyleText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"prefix" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StyleText -> XmlRep) -> StyleText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StyleText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StyleText
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StyleText -> XmlRep) -> Maybe StyleText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"figure-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StyleText -> XmlRep) -> StyleText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StyleText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StyleText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StyleText -> XmlRep) -> Maybe StyleText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"suffix" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StyleText -> XmlRep) -> StyleText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StyleText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StyleText
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Extend -> XmlRep) -> Maybe Extend -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"extend" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Extend -> XmlRep) -> Extend -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Extend -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Extend
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
e])
parseFigure :: P.XParse Figure
parseFigure :: XParse Figure
parseFigure = 
      Maybe StyleText
-> Maybe StyleText
-> Maybe StyleText
-> Maybe Extend
-> Editorial
-> Figure
Figure
        (Maybe StyleText
 -> Maybe StyleText
 -> Maybe StyleText
 -> Maybe Extend
 -> Editorial
 -> Figure)
-> XParse (Maybe StyleText)
-> XParse
     (Maybe StyleText
      -> Maybe StyleText -> Maybe Extend -> Editorial -> Figure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StyleText -> XParse (Maybe StyleText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse StyleText -> XParse StyleText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"prefix") (XParse StyleText
parseStyleText))
        XParse
  (Maybe StyleText
   -> Maybe StyleText -> Maybe Extend -> Editorial -> Figure)
-> XParse (Maybe StyleText)
-> XParse (Maybe StyleText -> Maybe Extend -> Editorial -> Figure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StyleText -> XParse (Maybe StyleText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse StyleText -> XParse StyleText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"figure-number") (XParse StyleText
parseStyleText))
        XParse (Maybe StyleText -> Maybe Extend -> Editorial -> Figure)
-> XParse (Maybe StyleText)
-> XParse (Maybe Extend -> Editorial -> Figure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StyleText -> XParse (Maybe StyleText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse StyleText -> XParse StyleText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"suffix") (XParse StyleText
parseStyleText))
        XParse (Maybe Extend -> Editorial -> Figure)
-> XParse (Maybe Extend) -> XParse (Editorial -> Figure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Extend -> XParse (Maybe Extend)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Extend -> XParse Extend
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"extend") (XParse Extend
parseExtend))
        XParse (Editorial -> Figure) -> XParse Editorial -> XParse Figure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial

-- | Smart constructor for 'Figure'
mkFigure :: Editorial -> Figure
mkFigure :: Editorial -> Figure
mkFigure Editorial
e = Maybe StyleText
-> Maybe StyleText
-> Maybe StyleText
-> Maybe Extend
-> Editorial
-> Figure
Figure Maybe StyleText
forall a. Maybe a
Nothing Maybe StyleText
forall a. Maybe a
Nothing Maybe StyleText
forall a. Maybe a
Nothing Maybe Extend
forall a. Maybe a
Nothing Editorial
e

-- | @figured-bass@ /(complex)/
--
-- The figured-bass element represents figured bass notation. Figured bass elements take their position from the first regular note (not a grace note or chord note) that follows in score order. The optional duration element is used to indicate changes of figures under a note.
-- 
-- Figures are ordered from top to bottom. The value of parentheses is "no" if not present.
data FiguredBass = 
      FiguredBass {
          FiguredBass -> Maybe YesNo
figuredBassParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , FiguredBass -> Maybe Tenths
figuredBassDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , FiguredBass -> Maybe Tenths
figuredBassDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , FiguredBass -> Maybe Tenths
figuredBassRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , FiguredBass -> Maybe Tenths
figuredBassRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , FiguredBass -> Maybe CommaSeparatedText
figuredBassFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , FiguredBass -> Maybe FontStyle
figuredBassFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , FiguredBass -> Maybe FontSize
figuredBassFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , FiguredBass -> Maybe FontWeight
figuredBassFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , FiguredBass -> Maybe Color
figuredBassColor :: (Maybe Color) -- ^ /color/ attribute
        , FiguredBass -> Maybe YesNo
figuredBassPrintDot :: (Maybe YesNo) -- ^ /print-dot/ attribute
        , FiguredBass -> Maybe YesNo
figuredBassPrintLyric :: (Maybe YesNo) -- ^ /print-lyric/ attribute
        , FiguredBass -> Maybe YesNo
figuredBassPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , FiguredBass -> Maybe YesNo
figuredBassPrintSpacing :: (Maybe YesNo) -- ^ /print-spacing/ attribute
        , FiguredBass -> Maybe ID
figuredBassId :: (Maybe ID) -- ^ /id/ attribute
        , FiguredBass -> [Figure]
figuredBassFigure :: [Figure] -- ^ /figure/ child element
        , FiguredBass -> Maybe Duration
figuredBassDuration :: (Maybe Duration)
        , FiguredBass -> Editorial
figuredBassEditorial :: Editorial
       }
    deriving (FiguredBass -> FiguredBass -> Bool
(FiguredBass -> FiguredBass -> Bool)
-> (FiguredBass -> FiguredBass -> Bool) -> Eq FiguredBass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FiguredBass -> FiguredBass -> Bool
$c/= :: FiguredBass -> FiguredBass -> Bool
== :: FiguredBass -> FiguredBass -> Bool
$c== :: FiguredBass -> FiguredBass -> Bool
Eq,Typeable,(forall x. FiguredBass -> Rep FiguredBass x)
-> (forall x. Rep FiguredBass x -> FiguredBass)
-> Generic FiguredBass
forall x. Rep FiguredBass x -> FiguredBass
forall x. FiguredBass -> Rep FiguredBass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FiguredBass x -> FiguredBass
$cfrom :: forall x. FiguredBass -> Rep FiguredBass x
Generic,Int -> FiguredBass -> ShowS
[FiguredBass] -> ShowS
FiguredBass -> String
(Int -> FiguredBass -> ShowS)
-> (FiguredBass -> String)
-> ([FiguredBass] -> ShowS)
-> Show FiguredBass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FiguredBass] -> ShowS
$cshowList :: [FiguredBass] -> ShowS
show :: FiguredBass -> String
$cshow :: FiguredBass -> String
showsPrec :: Int -> FiguredBass -> ShowS
$cshowsPrec :: Int -> FiguredBass -> ShowS
Show)
instance EmitXml FiguredBass where
    emitXml :: FiguredBass -> XmlRep
emitXml (FiguredBass Maybe YesNo
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe YesNo
k Maybe YesNo
l Maybe YesNo
m Maybe YesNo
n Maybe ID
o [Figure]
p Maybe Duration
q Editorial
r) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-lyric" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
o])
        ((Figure -> XmlRep) -> [Figure] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"figure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Figure -> XmlRep) -> Figure -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Figure -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Figure]
p [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe Duration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Duration
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
r])
parseFiguredBass :: P.XParse FiguredBass
parseFiguredBass :: XParse FiguredBass
parseFiguredBass = 
      Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe ID
-> [Figure]
-> Maybe Duration
-> Editorial
-> FiguredBass
FiguredBass
        (Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe ID
 -> [Figure]
 -> Maybe Duration
 -> Editorial
 -> FiguredBass)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-dot") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-lyric") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe ID
      -> [Figure]
      -> Maybe Duration
      -> Editorial
      -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe ID
   -> [Figure]
   -> Maybe Duration
   -> Editorial
   -> FiguredBass)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ID
      -> [Figure] -> Maybe Duration -> Editorial -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-spacing") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ID
   -> [Figure] -> Maybe Duration -> Editorial -> FiguredBass)
-> XParse (Maybe ID)
-> XParse ([Figure] -> Maybe Duration -> Editorial -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([Figure] -> Maybe Duration -> Editorial -> FiguredBass)
-> XParse [Figure]
-> XParse (Maybe Duration -> Editorial -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Figure -> XParse [Figure]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Figure -> XParse Figure
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"figure") (XParse Figure
parseFigure))
        XParse (Maybe Duration -> Editorial -> FiguredBass)
-> XParse (Maybe Duration) -> XParse (Editorial -> FiguredBass)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Duration -> XParse (Maybe Duration)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Duration
parseDuration)
        XParse (Editorial -> FiguredBass)
-> XParse Editorial -> XParse FiguredBass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial

-- | Smart constructor for 'FiguredBass'
mkFiguredBass :: Editorial -> FiguredBass
mkFiguredBass :: Editorial -> FiguredBass
mkFiguredBass Editorial
r = Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe ID
-> [Figure]
-> Maybe Duration
-> Editorial
-> FiguredBass
FiguredBass Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing [] Maybe Duration
forall a. Maybe a
Nothing Editorial
r

-- | @fingering@ /(complex)/
--
-- Fingering is typically indicated 1,2,3,4,5. Multiple fingerings may be given, typically to substitute fingerings in the middle of a note. The substitution and alternate values are "no" if the attribute is not present. For guitar and other fretted instruments, the fingering element represents the fretting finger; the pluck element represents the plucking finger.
data Fingering = 
      Fingering {
          Fingering -> String
fingeringString :: String -- ^ text content
        , Fingering -> Maybe YesNo
fingeringSubstitution :: (Maybe YesNo) -- ^ /substitution/ attribute
        , Fingering -> Maybe YesNo
fingeringAlternate :: (Maybe YesNo) -- ^ /alternate/ attribute
        , Fingering -> Maybe Tenths
fingeringDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Fingering -> Maybe Tenths
fingeringDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Fingering -> Maybe Tenths
fingeringRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Fingering -> Maybe Tenths
fingeringRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Fingering -> Maybe CommaSeparatedText
fingeringFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Fingering -> Maybe FontStyle
fingeringFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Fingering -> Maybe FontSize
fingeringFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Fingering -> Maybe FontWeight
fingeringFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Fingering -> Maybe Color
fingeringColor :: (Maybe Color) -- ^ /color/ attribute
        , Fingering -> Maybe AboveBelow
fingeringPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (Fingering -> Fingering -> Bool
(Fingering -> Fingering -> Bool)
-> (Fingering -> Fingering -> Bool) -> Eq Fingering
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingering -> Fingering -> Bool
$c/= :: Fingering -> Fingering -> Bool
== :: Fingering -> Fingering -> Bool
$c== :: Fingering -> Fingering -> Bool
Eq,Typeable,(forall x. Fingering -> Rep Fingering x)
-> (forall x. Rep Fingering x -> Fingering) -> Generic Fingering
forall x. Rep Fingering x -> Fingering
forall x. Fingering -> Rep Fingering x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fingering x -> Fingering
$cfrom :: forall x. Fingering -> Rep Fingering x
Generic,Int -> Fingering -> ShowS
[Fingering] -> ShowS
Fingering -> String
(Int -> Fingering -> ShowS)
-> (Fingering -> String)
-> ([Fingering] -> ShowS)
-> Show Fingering
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fingering] -> ShowS
$cshowList :: [Fingering] -> ShowS
show :: Fingering -> String
$cshow :: Fingering -> String
showsPrec :: Int -> Fingering -> ShowS
$cshowsPrec :: Int -> Fingering -> ShowS
Show)
instance EmitXml Fingering where
    emitXml :: Fingering -> XmlRep
emitXml (Fingering String
a Maybe YesNo
b Maybe YesNo
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l Maybe AboveBelow
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"substitution" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"alternate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
m])
        []
parseFingering :: P.XParse Fingering
parseFingering :: XParse Fingering
parseFingering = 
      String
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Fingering
Fingering
        (String
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Fingering)
-> XParse String
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"substitution") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"alternate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Fingering)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Fingering)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> Fingering)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> Fingering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Fingering)
-> XParse (Maybe AboveBelow) -> XParse Fingering
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'Fingering'
mkFingering :: String -> Fingering
mkFingering :: String -> Fingering
mkFingering String
a = String
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Fingering
Fingering String
a Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @first-fret@ /(complex)/
--
-- The first-fret type indicates which fret is shown in the top space of the frame; it is fret 1 if the element is not present. The optional text attribute indicates how this is represented in the fret diagram, while the location attribute indicates whether the text appears to the left or right of the frame.
data FirstFret = 
      FirstFret {
          FirstFret -> PositiveInteger
firstFretPositiveInteger :: PositiveInteger -- ^ text content
        , FirstFret -> Maybe Token
firstFretText :: (Maybe Token) -- ^ /text/ attribute
        , FirstFret -> Maybe LeftRight
firstFretLocation :: (Maybe LeftRight) -- ^ /location/ attribute
       }
    deriving (FirstFret -> FirstFret -> Bool
(FirstFret -> FirstFret -> Bool)
-> (FirstFret -> FirstFret -> Bool) -> Eq FirstFret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirstFret -> FirstFret -> Bool
$c/= :: FirstFret -> FirstFret -> Bool
== :: FirstFret -> FirstFret -> Bool
$c== :: FirstFret -> FirstFret -> Bool
Eq,Typeable,(forall x. FirstFret -> Rep FirstFret x)
-> (forall x. Rep FirstFret x -> FirstFret) -> Generic FirstFret
forall x. Rep FirstFret x -> FirstFret
forall x. FirstFret -> Rep FirstFret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FirstFret x -> FirstFret
$cfrom :: forall x. FirstFret -> Rep FirstFret x
Generic,Int -> FirstFret -> ShowS
[FirstFret] -> ShowS
FirstFret -> String
(Int -> FirstFret -> ShowS)
-> (FirstFret -> String)
-> ([FirstFret] -> ShowS)
-> Show FirstFret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirstFret] -> ShowS
$cshowList :: [FirstFret] -> ShowS
show :: FirstFret -> String
$cshow :: FirstFret -> String
showsPrec :: Int -> FirstFret -> ShowS
$cshowsPrec :: Int -> FirstFret -> ShowS
Show)
instance EmitXml FirstFret where
    emitXml :: FirstFret -> XmlRep
emitXml (FirstFret PositiveInteger
a Maybe Token
b Maybe LeftRight
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LeftRight -> XmlRep) -> Maybe LeftRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LeftRight -> XmlRep) -> LeftRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftRight
c])
        []
parseFirstFret :: P.XParse FirstFret
parseFirstFret :: XParse FirstFret
parseFirstFret = 
      PositiveInteger -> Maybe Token -> Maybe LeftRight -> FirstFret
FirstFret
        (PositiveInteger -> Maybe Token -> Maybe LeftRight -> FirstFret)
-> XParse PositiveInteger
-> XParse (Maybe Token -> Maybe LeftRight -> FirstFret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse (Maybe Token -> Maybe LeftRight -> FirstFret)
-> XParse (Maybe Token) -> XParse (Maybe LeftRight -> FirstFret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe LeftRight -> FirstFret)
-> XParse (Maybe LeftRight) -> XParse FirstFret
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftRight -> XParse (Maybe LeftRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String -> (String -> XParse LeftRight) -> XParse LeftRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftRight
parseLeftRight)

-- | Smart constructor for 'FirstFret'
mkFirstFret :: PositiveInteger -> FirstFret
mkFirstFret :: PositiveInteger -> FirstFret
mkFirstFret PositiveInteger
a = PositiveInteger -> Maybe Token -> Maybe LeftRight -> FirstFret
FirstFret PositiveInteger
a Maybe Token
forall a. Maybe a
Nothing Maybe LeftRight
forall a. Maybe a
Nothing

-- | @formatted-symbol-id@ /(complex)/
--
-- The formatted-symbol-id type represents a SMuFL musical symbol element with formatting and id attributes.
data FormattedSymbolId = 
      FormattedSymbolId {
          FormattedSymbolId -> SmuflGlyphName
formattedSymbolIdSmuflGlyphName :: SmuflGlyphName -- ^ text content
        , FormattedSymbolId -> Maybe LeftCenterRight
formattedSymbolIdJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , FormattedSymbolId -> Maybe Tenths
formattedSymbolIdDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , FormattedSymbolId -> Maybe Tenths
formattedSymbolIdDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , FormattedSymbolId -> Maybe Tenths
formattedSymbolIdRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , FormattedSymbolId -> Maybe Tenths
formattedSymbolIdRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , FormattedSymbolId -> Maybe CommaSeparatedText
formattedSymbolIdFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , FormattedSymbolId -> Maybe FontStyle
formattedSymbolIdFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , FormattedSymbolId -> Maybe FontSize
formattedSymbolIdFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , FormattedSymbolId -> Maybe FontWeight
formattedSymbolIdFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , FormattedSymbolId -> Maybe Color
formattedSymbolIdColor :: (Maybe Color) -- ^ /color/ attribute
        , FormattedSymbolId -> Maybe LeftCenterRight
formattedSymbolIdHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , FormattedSymbolId -> Maybe Valign
formattedSymbolIdValign :: (Maybe Valign) -- ^ /valign/ attribute
        , FormattedSymbolId -> Maybe NumberOfLines
formattedSymbolIdUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , FormattedSymbolId -> Maybe NumberOfLines
formattedSymbolIdOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , FormattedSymbolId -> Maybe NumberOfLines
formattedSymbolIdLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , FormattedSymbolId -> Maybe RotationDegrees
formattedSymbolIdRotation :: (Maybe RotationDegrees) -- ^ /rotation/ attribute
        , FormattedSymbolId -> Maybe NumberOrNormal
formattedSymbolIdLetterSpacing :: (Maybe NumberOrNormal) -- ^ /letter-spacing/ attribute
        , FormattedSymbolId -> Maybe NumberOrNormal
formattedSymbolIdLineHeight :: (Maybe NumberOrNormal) -- ^ /line-height/ attribute
        , FormattedSymbolId -> Maybe TextDirection
formattedSymbolIdDir :: (Maybe TextDirection) -- ^ /dir/ attribute
        , FormattedSymbolId -> Maybe EnclosureShape
formattedSymbolIdEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
        , FormattedSymbolId -> Maybe ID
formattedSymbolIdId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (FormattedSymbolId -> FormattedSymbolId -> Bool
(FormattedSymbolId -> FormattedSymbolId -> Bool)
-> (FormattedSymbolId -> FormattedSymbolId -> Bool)
-> Eq FormattedSymbolId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedSymbolId -> FormattedSymbolId -> Bool
$c/= :: FormattedSymbolId -> FormattedSymbolId -> Bool
== :: FormattedSymbolId -> FormattedSymbolId -> Bool
$c== :: FormattedSymbolId -> FormattedSymbolId -> Bool
Eq,Typeable,(forall x. FormattedSymbolId -> Rep FormattedSymbolId x)
-> (forall x. Rep FormattedSymbolId x -> FormattedSymbolId)
-> Generic FormattedSymbolId
forall x. Rep FormattedSymbolId x -> FormattedSymbolId
forall x. FormattedSymbolId -> Rep FormattedSymbolId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormattedSymbolId x -> FormattedSymbolId
$cfrom :: forall x. FormattedSymbolId -> Rep FormattedSymbolId x
Generic,Int -> FormattedSymbolId -> ShowS
[FormattedSymbolId] -> ShowS
FormattedSymbolId -> String
(Int -> FormattedSymbolId -> ShowS)
-> (FormattedSymbolId -> String)
-> ([FormattedSymbolId] -> ShowS)
-> Show FormattedSymbolId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattedSymbolId] -> ShowS
$cshowList :: [FormattedSymbolId] -> ShowS
show :: FormattedSymbolId -> String
$cshow :: FormattedSymbolId -> String
showsPrec :: Int -> FormattedSymbolId -> ShowS
$cshowsPrec :: Int -> FormattedSymbolId -> ShowS
Show)
instance EmitXml FormattedSymbolId where
    emitXml :: FormattedSymbolId -> XmlRep
emitXml (FormattedSymbolId SmuflGlyphName
a Maybe LeftCenterRight
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k Maybe LeftCenterRight
l Maybe Valign
m Maybe NumberOfLines
n Maybe NumberOfLines
o Maybe NumberOfLines
p Maybe RotationDegrees
q Maybe NumberOrNormal
r Maybe NumberOrNormal
s Maybe TextDirection
t Maybe EnclosureShape
u Maybe ID
v) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SmuflGlyphName
a)
        ([XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"rotation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"letter-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TextDirection -> XmlRep) -> Maybe TextDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dir" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TextDirection -> XmlRep) -> TextDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TextDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TextDirection
t] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
u] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
v])
        []
parseFormattedSymbolId :: P.XParse FormattedSymbolId
parseFormattedSymbolId :: XParse FormattedSymbolId
parseFormattedSymbolId = 
      SmuflGlyphName
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> Maybe ID
-> FormattedSymbolId
FormattedSymbolId
        (SmuflGlyphName
 -> Maybe LeftCenterRight
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe RotationDegrees
 -> Maybe NumberOrNormal
 -> Maybe NumberOrNormal
 -> Maybe TextDirection
 -> Maybe EnclosureShape
 -> Maybe ID
 -> FormattedSymbolId)
-> XParse SmuflGlyphName
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe Valign)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"rotation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"letter-spacing") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedSymbolId)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe TextDirection
      -> Maybe EnclosureShape -> Maybe ID -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-height") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe TextDirection
   -> Maybe EnclosureShape -> Maybe ID -> FormattedSymbolId)
-> XParse (Maybe TextDirection)
-> XParse (Maybe EnclosureShape -> Maybe ID -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TextDirection -> XParse (Maybe TextDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dir") XParse String
-> (String -> XParse TextDirection) -> XParse TextDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TextDirection
parseTextDirection)
        XParse (Maybe EnclosureShape -> Maybe ID -> FormattedSymbolId)
-> XParse (Maybe EnclosureShape)
-> XParse (Maybe ID -> FormattedSymbolId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)
        XParse (Maybe ID -> FormattedSymbolId)
-> XParse (Maybe ID) -> XParse FormattedSymbolId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'FormattedSymbolId'
mkFormattedSymbolId :: SmuflGlyphName -> FormattedSymbolId
mkFormattedSymbolId :: SmuflGlyphName -> FormattedSymbolId
mkFormattedSymbolId SmuflGlyphName
a = SmuflGlyphName
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> Maybe ID
-> FormattedSymbolId
FormattedSymbolId SmuflGlyphName
a Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe TextDirection
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @formatted-text@ /(complex)/
--
-- The formatted-text type represents a text element with text-formatting attributes.
data FormattedText = 
      FormattedText {
          FormattedText -> String
formattedTextString :: String -- ^ text content
        , FormattedText -> Maybe Lang
formattedTextLang :: (Maybe Lang) -- ^ /xml:lang/ attribute
        , FormattedText -> Maybe Space
formattedTextSpace :: (Maybe Space) -- ^ /xml:space/ attribute
        , FormattedText -> Maybe LeftCenterRight
formattedTextJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , FormattedText -> Maybe Tenths
formattedTextDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , FormattedText -> Maybe Tenths
formattedTextDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , FormattedText -> Maybe Tenths
formattedTextRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , FormattedText -> Maybe Tenths
formattedTextRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , FormattedText -> Maybe CommaSeparatedText
formattedTextFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , FormattedText -> Maybe FontStyle
formattedTextFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , FormattedText -> Maybe FontSize
formattedTextFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , FormattedText -> Maybe FontWeight
formattedTextFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , FormattedText -> Maybe Color
formattedTextColor :: (Maybe Color) -- ^ /color/ attribute
        , FormattedText -> Maybe LeftCenterRight
formattedTextHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , FormattedText -> Maybe Valign
formattedTextValign :: (Maybe Valign) -- ^ /valign/ attribute
        , FormattedText -> Maybe NumberOfLines
formattedTextUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , FormattedText -> Maybe NumberOfLines
formattedTextOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , FormattedText -> Maybe NumberOfLines
formattedTextLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , FormattedText -> Maybe RotationDegrees
formattedTextRotation :: (Maybe RotationDegrees) -- ^ /rotation/ attribute
        , FormattedText -> Maybe NumberOrNormal
formattedTextLetterSpacing :: (Maybe NumberOrNormal) -- ^ /letter-spacing/ attribute
        , FormattedText -> Maybe NumberOrNormal
formattedTextLineHeight :: (Maybe NumberOrNormal) -- ^ /line-height/ attribute
        , FormattedText -> Maybe TextDirection
formattedTextDir :: (Maybe TextDirection) -- ^ /dir/ attribute
        , FormattedText -> Maybe EnclosureShape
formattedTextEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
       }
    deriving (FormattedText -> FormattedText -> Bool
(FormattedText -> FormattedText -> Bool)
-> (FormattedText -> FormattedText -> Bool) -> Eq FormattedText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedText -> FormattedText -> Bool
$c/= :: FormattedText -> FormattedText -> Bool
== :: FormattedText -> FormattedText -> Bool
$c== :: FormattedText -> FormattedText -> Bool
Eq,Typeable,(forall x. FormattedText -> Rep FormattedText x)
-> (forall x. Rep FormattedText x -> FormattedText)
-> Generic FormattedText
forall x. Rep FormattedText x -> FormattedText
forall x. FormattedText -> Rep FormattedText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormattedText x -> FormattedText
$cfrom :: forall x. FormattedText -> Rep FormattedText x
Generic,Int -> FormattedText -> ShowS
[FormattedText] -> ShowS
FormattedText -> String
(Int -> FormattedText -> ShowS)
-> (FormattedText -> String)
-> ([FormattedText] -> ShowS)
-> Show FormattedText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattedText] -> ShowS
$cshowList :: [FormattedText] -> ShowS
show :: FormattedText -> String
$cshow :: FormattedText -> String
showsPrec :: Int -> FormattedText -> ShowS
$cshowsPrec :: Int -> FormattedText -> ShowS
Show)
instance EmitXml FormattedText where
    emitXml :: FormattedText -> XmlRep
emitXml (FormattedText String
a Maybe Lang
b Maybe Space
c Maybe LeftCenterRight
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe CommaSeparatedText
i Maybe FontStyle
j Maybe FontSize
k Maybe FontWeight
l Maybe Color
m Maybe LeftCenterRight
n Maybe Valign
o Maybe NumberOfLines
p Maybe NumberOfLines
q Maybe NumberOfLines
r Maybe RotationDegrees
s Maybe NumberOrNormal
t Maybe NumberOrNormal
u Maybe TextDirection
v Maybe EnclosureShape
w) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Lang -> XmlRep) -> Maybe Lang -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Lang -> XmlRep) -> Lang -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Lang
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Space -> XmlRep) -> Maybe Space -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Space -> XmlRep) -> Space -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Space -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Space
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"rotation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"letter-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
t] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
u] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TextDirection -> XmlRep) -> Maybe TextDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dir" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TextDirection -> XmlRep) -> TextDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TextDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TextDirection
v] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
w])
        []
parseFormattedText :: P.XParse FormattedText
parseFormattedText :: XParse FormattedText
parseFormattedText = 
      String
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> FormattedText
FormattedText
        (String
 -> Maybe Lang
 -> Maybe Space
 -> Maybe LeftCenterRight
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe RotationDegrees
 -> Maybe NumberOrNormal
 -> Maybe NumberOrNormal
 -> Maybe TextDirection
 -> Maybe EnclosureShape
 -> FormattedText)
-> XParse String
-> XParse
     (Maybe Lang
      -> Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Lang
   -> Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Lang)
-> XParse
     (Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lang -> XParse (Maybe Lang)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)
        XParse
  (Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Space)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Space -> XParse (Maybe Space)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:space") XParse String -> (String -> XParse Space) -> XParse Space
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Space
parseSpace)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe Valign)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"rotation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> FormattedText)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe TextDirection -> Maybe EnclosureShape -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"letter-spacing") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe NumberOrNormal
   -> Maybe TextDirection -> Maybe EnclosureShape -> FormattedText)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe TextDirection -> Maybe EnclosureShape -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-height") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe TextDirection -> Maybe EnclosureShape -> FormattedText)
-> XParse (Maybe TextDirection)
-> XParse (Maybe EnclosureShape -> FormattedText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TextDirection -> XParse (Maybe TextDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dir") XParse String
-> (String -> XParse TextDirection) -> XParse TextDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TextDirection
parseTextDirection)
        XParse (Maybe EnclosureShape -> FormattedText)
-> XParse (Maybe EnclosureShape) -> XParse FormattedText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)

-- | Smart constructor for 'FormattedText'
mkFormattedText :: String -> FormattedText
mkFormattedText :: String -> FormattedText
mkFormattedText String
a = String
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> FormattedText
FormattedText String
a Maybe Lang
forall a. Maybe a
Nothing Maybe Space
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe TextDirection
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing

-- | @formatted-text-id@ /(complex)/
--
-- The formatted-text-id type represents a text element with text-formatting and id attributes.
data FormattedTextId = 
      FormattedTextId {
          FormattedTextId -> String
formattedTextIdString :: String -- ^ text content
        , FormattedTextId -> Maybe Lang
formattedTextIdLang :: (Maybe Lang) -- ^ /xml:lang/ attribute
        , FormattedTextId -> Maybe Space
formattedTextIdSpace :: (Maybe Space) -- ^ /xml:space/ attribute
        , FormattedTextId -> Maybe LeftCenterRight
formattedTextIdJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , FormattedTextId -> Maybe Tenths
formattedTextIdDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , FormattedTextId -> Maybe Tenths
formattedTextIdDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , FormattedTextId -> Maybe Tenths
formattedTextIdRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , FormattedTextId -> Maybe Tenths
formattedTextIdRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , FormattedTextId -> Maybe CommaSeparatedText
formattedTextIdFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , FormattedTextId -> Maybe FontStyle
formattedTextIdFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , FormattedTextId -> Maybe FontSize
formattedTextIdFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , FormattedTextId -> Maybe FontWeight
formattedTextIdFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , FormattedTextId -> Maybe Color
formattedTextIdColor :: (Maybe Color) -- ^ /color/ attribute
        , FormattedTextId -> Maybe LeftCenterRight
formattedTextIdHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , FormattedTextId -> Maybe Valign
formattedTextIdValign :: (Maybe Valign) -- ^ /valign/ attribute
        , FormattedTextId -> Maybe NumberOfLines
formattedTextIdUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , FormattedTextId -> Maybe NumberOfLines
formattedTextIdOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , FormattedTextId -> Maybe NumberOfLines
formattedTextIdLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , FormattedTextId -> Maybe RotationDegrees
formattedTextIdRotation :: (Maybe RotationDegrees) -- ^ /rotation/ attribute
        , FormattedTextId -> Maybe NumberOrNormal
formattedTextIdLetterSpacing :: (Maybe NumberOrNormal) -- ^ /letter-spacing/ attribute
        , FormattedTextId -> Maybe NumberOrNormal
formattedTextIdLineHeight :: (Maybe NumberOrNormal) -- ^ /line-height/ attribute
        , FormattedTextId -> Maybe TextDirection
formattedTextIdDir :: (Maybe TextDirection) -- ^ /dir/ attribute
        , FormattedTextId -> Maybe EnclosureShape
formattedTextIdEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
        , FormattedTextId -> Maybe ID
formattedTextIdId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (FormattedTextId -> FormattedTextId -> Bool
(FormattedTextId -> FormattedTextId -> Bool)
-> (FormattedTextId -> FormattedTextId -> Bool)
-> Eq FormattedTextId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattedTextId -> FormattedTextId -> Bool
$c/= :: FormattedTextId -> FormattedTextId -> Bool
== :: FormattedTextId -> FormattedTextId -> Bool
$c== :: FormattedTextId -> FormattedTextId -> Bool
Eq,Typeable,(forall x. FormattedTextId -> Rep FormattedTextId x)
-> (forall x. Rep FormattedTextId x -> FormattedTextId)
-> Generic FormattedTextId
forall x. Rep FormattedTextId x -> FormattedTextId
forall x. FormattedTextId -> Rep FormattedTextId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FormattedTextId x -> FormattedTextId
$cfrom :: forall x. FormattedTextId -> Rep FormattedTextId x
Generic,Int -> FormattedTextId -> ShowS
[FormattedTextId] -> ShowS
FormattedTextId -> String
(Int -> FormattedTextId -> ShowS)
-> (FormattedTextId -> String)
-> ([FormattedTextId] -> ShowS)
-> Show FormattedTextId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattedTextId] -> ShowS
$cshowList :: [FormattedTextId] -> ShowS
show :: FormattedTextId -> String
$cshow :: FormattedTextId -> String
showsPrec :: Int -> FormattedTextId -> ShowS
$cshowsPrec :: Int -> FormattedTextId -> ShowS
Show)
instance EmitXml FormattedTextId where
    emitXml :: FormattedTextId -> XmlRep
emitXml (FormattedTextId String
a Maybe Lang
b Maybe Space
c Maybe LeftCenterRight
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe CommaSeparatedText
i Maybe FontStyle
j Maybe FontSize
k Maybe FontWeight
l Maybe Color
m Maybe LeftCenterRight
n Maybe Valign
o Maybe NumberOfLines
p Maybe NumberOfLines
q Maybe NumberOfLines
r Maybe RotationDegrees
s Maybe NumberOrNormal
t Maybe NumberOrNormal
u Maybe TextDirection
v Maybe EnclosureShape
w Maybe ID
x) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Lang -> XmlRep) -> Maybe Lang -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Lang -> XmlRep) -> Lang -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Lang
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Space -> XmlRep) -> Maybe Space -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Space -> XmlRep) -> Space -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Space -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Space
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"rotation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"letter-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
t] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
u] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TextDirection -> XmlRep) -> Maybe TextDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dir" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TextDirection -> XmlRep) -> TextDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TextDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TextDirection
v] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
w] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
x])
        []
parseFormattedTextId :: P.XParse FormattedTextId
parseFormattedTextId :: XParse FormattedTextId
parseFormattedTextId = 
      String
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> Maybe ID
-> FormattedTextId
FormattedTextId
        (String
 -> Maybe Lang
 -> Maybe Space
 -> Maybe LeftCenterRight
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe RotationDegrees
 -> Maybe NumberOrNormal
 -> Maybe NumberOrNormal
 -> Maybe TextDirection
 -> Maybe EnclosureShape
 -> Maybe ID
 -> FormattedTextId)
-> XParse String
-> XParse
     (Maybe Lang
      -> Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Lang
   -> Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Lang)
-> XParse
     (Maybe Space
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lang -> XParse (Maybe Lang)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)
        XParse
  (Maybe Space
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Space)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Space -> XParse (Maybe Space)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:space") XParse String -> (String -> XParse Space) -> XParse Space
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Space
parseSpace)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe Valign)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"rotation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe NumberOrNormal
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe NumberOrNormal
      -> Maybe TextDirection
      -> Maybe EnclosureShape
      -> Maybe ID
      -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"letter-spacing") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe NumberOrNormal
   -> Maybe TextDirection
   -> Maybe EnclosureShape
   -> Maybe ID
   -> FormattedTextId)
-> XParse (Maybe NumberOrNormal)
-> XParse
     (Maybe TextDirection
      -> Maybe EnclosureShape -> Maybe ID -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-height") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse
  (Maybe TextDirection
   -> Maybe EnclosureShape -> Maybe ID -> FormattedTextId)
-> XParse (Maybe TextDirection)
-> XParse (Maybe EnclosureShape -> Maybe ID -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TextDirection -> XParse (Maybe TextDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dir") XParse String
-> (String -> XParse TextDirection) -> XParse TextDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TextDirection
parseTextDirection)
        XParse (Maybe EnclosureShape -> Maybe ID -> FormattedTextId)
-> XParse (Maybe EnclosureShape)
-> XParse (Maybe ID -> FormattedTextId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)
        XParse (Maybe ID -> FormattedTextId)
-> XParse (Maybe ID) -> XParse FormattedTextId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'FormattedTextId'
mkFormattedTextId :: String -> FormattedTextId
mkFormattedTextId :: String -> FormattedTextId
mkFormattedTextId String
a = String
-> Maybe Lang
-> Maybe Space
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> Maybe EnclosureShape
-> Maybe ID
-> FormattedTextId
FormattedTextId String
a Maybe Lang
forall a. Maybe a
Nothing Maybe Space
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe TextDirection
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @forward@ /(complex)/
--
-- The backup and forward elements are required to coordinate multiple voices in one part, including music on multiple staves. The forward element is generally used within voices and staves. Duration values should always be positive, and should not cross measure boundaries or mid-measure changes in the divisions value.
data Forward = 
      Forward {
          Forward -> Duration
forwardDuration :: Duration
        , Forward -> EditorialVoice
forwardEditorialVoice :: EditorialVoice
        , Forward -> Maybe Staff
forwardStaff :: (Maybe Staff)
       }
    deriving (Forward -> Forward -> Bool
(Forward -> Forward -> Bool)
-> (Forward -> Forward -> Bool) -> Eq Forward
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Forward -> Forward -> Bool
$c/= :: Forward -> Forward -> Bool
== :: Forward -> Forward -> Bool
$c== :: Forward -> Forward -> Bool
Eq,Typeable,(forall x. Forward -> Rep Forward x)
-> (forall x. Rep Forward x -> Forward) -> Generic Forward
forall x. Rep Forward x -> Forward
forall x. Forward -> Rep Forward x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Forward x -> Forward
$cfrom :: forall x. Forward -> Rep Forward x
Generic,Int -> Forward -> ShowS
[Forward] -> ShowS
Forward -> String
(Int -> Forward -> ShowS)
-> (Forward -> String) -> ([Forward] -> ShowS) -> Show Forward
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Forward] -> ShowS
$cshowList :: [Forward] -> ShowS
show :: Forward -> String
$cshow :: Forward -> String
showsPrec :: Int -> Forward -> ShowS
$cshowsPrec :: Int -> Forward -> ShowS
Show)
instance EmitXml Forward where
    emitXml :: Forward -> XmlRep
emitXml (Forward Duration
a EditorialVoice
b Maybe Staff
c) =
      [XmlRep] -> XmlRep
XReps [Duration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Duration
a,EditorialVoice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EditorialVoice
b,Maybe Staff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Staff
c]
parseForward :: P.XParse Forward
parseForward :: XParse Forward
parseForward = 
      Duration -> EditorialVoice -> Maybe Staff -> Forward
Forward
        (Duration -> EditorialVoice -> Maybe Staff -> Forward)
-> XParse Duration
-> XParse (EditorialVoice -> Maybe Staff -> Forward)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Duration
parseDuration
        XParse (EditorialVoice -> Maybe Staff -> Forward)
-> XParse EditorialVoice -> XParse (Maybe Staff -> Forward)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EditorialVoice
parseEditorialVoice
        XParse (Maybe Staff -> Forward)
-> XParse (Maybe Staff) -> XParse Forward
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Staff -> XParse (Maybe Staff)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Staff
parseStaff)

-- | Smart constructor for 'Forward'
mkForward :: Duration -> EditorialVoice -> Forward
mkForward :: Duration -> EditorialVoice -> Forward
mkForward Duration
a EditorialVoice
b = Duration -> EditorialVoice -> Maybe Staff -> Forward
Forward Duration
a EditorialVoice
b Maybe Staff
forall a. Maybe a
Nothing

-- | @frame@ /(complex)/
--
-- The frame type represents a frame or fretboard diagram used together with a chord symbol. The representation is based on the NIFF guitar grid with additional information. The frame type's unplayed attribute indicates what to display above a string that has no associated frame-note element. Typical values are x and the empty string. If the attribute is not present, the display of the unplayed string is application-defined.
data Frame = 
      Frame {
          Frame -> Maybe Tenths
frameHeight :: (Maybe Tenths) -- ^ /height/ attribute
        , Frame -> Maybe Tenths
frameWidth :: (Maybe Tenths) -- ^ /width/ attribute
        , Frame -> Maybe Token
frameUnplayed :: (Maybe Token) -- ^ /unplayed/ attribute
        , Frame -> Maybe Tenths
frameDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Frame -> Maybe Tenths
frameDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Frame -> Maybe Tenths
frameRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Frame -> Maybe Tenths
frameRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Frame -> Maybe Color
frameColor :: (Maybe Color) -- ^ /color/ attribute
        , Frame -> Maybe LeftCenterRight
frameHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Frame -> Maybe ValignImage
frameValign :: (Maybe ValignImage) -- ^ /valign/ attribute
        , Frame -> Maybe ID
frameId :: (Maybe ID) -- ^ /id/ attribute
        , Frame -> PositiveInteger
frameFrameStrings :: PositiveInteger -- ^ /frame-strings/ child element
        , Frame -> PositiveInteger
frameFrameFrets :: PositiveInteger -- ^ /frame-frets/ child element
        , Frame -> Maybe FirstFret
frameFirstFret :: (Maybe FirstFret) -- ^ /first-fret/ child element
        , Frame -> [FrameNote]
frameFrameNote :: [FrameNote] -- ^ /frame-note/ child element
       }
    deriving (Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq,Typeable,(forall x. Frame -> Rep Frame x)
-> (forall x. Rep Frame x -> Frame) -> Generic Frame
forall x. Rep Frame x -> Frame
forall x. Frame -> Rep Frame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Frame x -> Frame
$cfrom :: forall x. Frame -> Rep Frame x
Generic,Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)
instance EmitXml Frame where
    emitXml :: Frame -> XmlRep
emitXml (Frame Maybe Tenths
a Maybe Tenths
b Maybe Token
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Color
h Maybe LeftCenterRight
i Maybe ValignImage
j Maybe ID
k PositiveInteger
l PositiveInteger
m Maybe FirstFret
n [FrameNote]
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"width" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"unplayed" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ValignImage -> XmlRep) -> Maybe ValignImage -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ValignImage -> XmlRep) -> ValignImage -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ValignImage -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ValignImage
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
k])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"frame-strings" Maybe String
forall a. Maybe a
Nothing) (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
l)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"frame-frets" Maybe String
forall a. Maybe a
Nothing) (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
m)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FirstFret -> XmlRep) -> Maybe FirstFret -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"first-fret" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FirstFret -> XmlRep) -> FirstFret -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FirstFret -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FirstFret
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (FrameNote -> XmlRep) -> [FrameNote] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"frame-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FrameNote -> XmlRep) -> FrameNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FrameNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [FrameNote]
o)
parseFrame :: P.XParse Frame
parseFrame :: XParse Frame
parseFrame = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe ValignImage
-> Maybe ID
-> PositiveInteger
-> PositiveInteger
-> Maybe FirstFret
-> [FrameNote]
-> Frame
Frame
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe ValignImage
 -> Maybe ID
 -> PositiveInteger
 -> PositiveInteger
 -> Maybe FirstFret
 -> [FrameNote]
 -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"height") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"width") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Token)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"unplayed") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe ValignImage
      -> Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe ValignImage
   -> Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe ValignImage)
-> XParse
     (Maybe ID
      -> PositiveInteger
      -> PositiveInteger
      -> Maybe FirstFret
      -> [FrameNote]
      -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ValignImage -> XParse (Maybe ValignImage)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String
-> (String -> XParse ValignImage) -> XParse ValignImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ValignImage
parseValignImage)
        XParse
  (Maybe ID
   -> PositiveInteger
   -> PositiveInteger
   -> Maybe FirstFret
   -> [FrameNote]
   -> Frame)
-> XParse (Maybe ID)
-> XParse
     (PositiveInteger
      -> PositiveInteger -> Maybe FirstFret -> [FrameNote] -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (PositiveInteger
   -> PositiveInteger -> Maybe FirstFret -> [FrameNote] -> Frame)
-> XParse PositiveInteger
-> XParse
     (PositiveInteger -> Maybe FirstFret -> [FrameNote] -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse PositiveInteger -> XParse PositiveInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"frame-strings") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger))
        XParse (PositiveInteger -> Maybe FirstFret -> [FrameNote] -> Frame)
-> XParse PositiveInteger
-> XParse (Maybe FirstFret -> [FrameNote] -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse PositiveInteger -> XParse PositiveInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"frame-frets") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger))
        XParse (Maybe FirstFret -> [FrameNote] -> Frame)
-> XParse (Maybe FirstFret) -> XParse ([FrameNote] -> Frame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FirstFret -> XParse (Maybe FirstFret)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse FirstFret -> XParse FirstFret
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"first-fret") (XParse FirstFret
parseFirstFret))
        XParse ([FrameNote] -> Frame) -> XParse [FrameNote] -> XParse Frame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FrameNote -> XParse [FrameNote]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse FrameNote -> XParse FrameNote
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"frame-note") (XParse FrameNote
parseFrameNote))

-- | Smart constructor for 'Frame'
mkFrame :: PositiveInteger -> PositiveInteger -> Frame
mkFrame :: PositiveInteger -> PositiveInteger -> Frame
mkFrame PositiveInteger
l PositiveInteger
m = Maybe Tenths
-> Maybe Tenths
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe ValignImage
-> Maybe ID
-> PositiveInteger
-> PositiveInteger
-> Maybe FirstFret
-> [FrameNote]
-> Frame
Frame Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe ValignImage
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing PositiveInteger
l PositiveInteger
m Maybe FirstFret
forall a. Maybe a
Nothing []

-- | @frame-note@ /(complex)/
--
-- The frame-note type represents each note included in the frame. An open string will have a fret value of 0, while a muted string will not be associated with a frame-note element.
data FrameNote = 
      FrameNote {
          FrameNote -> CmpString
frameNoteString :: CmpString -- ^ /string/ child element
        , FrameNote -> Fret
frameNoteFret :: Fret -- ^ /fret/ child element
        , FrameNote -> Maybe Fingering
frameNoteFingering :: (Maybe Fingering) -- ^ /fingering/ child element
        , FrameNote -> Maybe Barre
frameNoteBarre :: (Maybe Barre) -- ^ /barre/ child element
       }
    deriving (FrameNote -> FrameNote -> Bool
(FrameNote -> FrameNote -> Bool)
-> (FrameNote -> FrameNote -> Bool) -> Eq FrameNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameNote -> FrameNote -> Bool
$c/= :: FrameNote -> FrameNote -> Bool
== :: FrameNote -> FrameNote -> Bool
$c== :: FrameNote -> FrameNote -> Bool
Eq,Typeable,(forall x. FrameNote -> Rep FrameNote x)
-> (forall x. Rep FrameNote x -> FrameNote) -> Generic FrameNote
forall x. Rep FrameNote x -> FrameNote
forall x. FrameNote -> Rep FrameNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FrameNote x -> FrameNote
$cfrom :: forall x. FrameNote -> Rep FrameNote x
Generic,Int -> FrameNote -> ShowS
[FrameNote] -> ShowS
FrameNote -> String
(Int -> FrameNote -> ShowS)
-> (FrameNote -> String)
-> ([FrameNote] -> ShowS)
-> Show FrameNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameNote] -> ShowS
$cshowList :: [FrameNote] -> ShowS
show :: FrameNote -> String
$cshow :: FrameNote -> String
showsPrec :: Int -> FrameNote -> ShowS
$cshowsPrec :: Int -> FrameNote -> ShowS
Show)
instance EmitXml FrameNote where
    emitXml :: FrameNote -> XmlRep
emitXml (FrameNote CmpString
a Fret
b Maybe Fingering
c Maybe Barre
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"string" Maybe String
forall a. Maybe a
Nothing) (CmpString -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CmpString
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fret" Maybe String
forall a. Maybe a
Nothing) (Fret -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fret
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Fingering -> XmlRep) -> Maybe Fingering -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fingering" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Fingering -> XmlRep) -> Fingering -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Fingering -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Fingering
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Barre -> XmlRep) -> Maybe Barre -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"barre" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Barre -> XmlRep) -> Barre -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Barre -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Barre
d])
parseFrameNote :: P.XParse FrameNote
parseFrameNote :: XParse FrameNote
parseFrameNote = 
      CmpString -> Fret -> Maybe Fingering -> Maybe Barre -> FrameNote
FrameNote
        (CmpString -> Fret -> Maybe Fingering -> Maybe Barre -> FrameNote)
-> XParse CmpString
-> XParse (Fret -> Maybe Fingering -> Maybe Barre -> FrameNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse CmpString -> XParse CmpString
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"string") (XParse CmpString
parseCmpString))
        XParse (Fret -> Maybe Fingering -> Maybe Barre -> FrameNote)
-> XParse Fret
-> XParse (Maybe Fingering -> Maybe Barre -> FrameNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Fret -> XParse Fret
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fret") (XParse Fret
parseFret))
        XParse (Maybe Fingering -> Maybe Barre -> FrameNote)
-> XParse (Maybe Fingering) -> XParse (Maybe Barre -> FrameNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Fingering -> XParse (Maybe Fingering)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Fingering -> XParse Fingering
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fingering") (XParse Fingering
parseFingering))
        XParse (Maybe Barre -> FrameNote)
-> XParse (Maybe Barre) -> XParse FrameNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Barre -> XParse (Maybe Barre)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Barre -> XParse Barre
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"barre") (XParse Barre
parseBarre))

-- | Smart constructor for 'FrameNote'
mkFrameNote :: CmpString -> Fret -> FrameNote
mkFrameNote :: CmpString -> Fret -> FrameNote
mkFrameNote CmpString
a Fret
b = CmpString -> Fret -> Maybe Fingering -> Maybe Barre -> FrameNote
FrameNote CmpString
a Fret
b Maybe Fingering
forall a. Maybe a
Nothing Maybe Barre
forall a. Maybe a
Nothing

-- | @fret@ /(complex)/
--
-- The fret element is used with tablature notation and chord diagrams. Fret numbers start with 0 for an open string and 1 for the first fret.
data Fret = 
      Fret {
          Fret -> NonNegativeInteger
fretNonNegativeInteger :: NonNegativeInteger -- ^ text content
        , Fret -> Maybe CommaSeparatedText
fretFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Fret -> Maybe FontStyle
fretFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Fret -> Maybe FontSize
fretFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Fret -> Maybe FontWeight
fretFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Fret -> Maybe Color
fretColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Fret -> Fret -> Bool
(Fret -> Fret -> Bool) -> (Fret -> Fret -> Bool) -> Eq Fret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fret -> Fret -> Bool
$c/= :: Fret -> Fret -> Bool
== :: Fret -> Fret -> Bool
$c== :: Fret -> Fret -> Bool
Eq,Typeable,(forall x. Fret -> Rep Fret x)
-> (forall x. Rep Fret x -> Fret) -> Generic Fret
forall x. Rep Fret x -> Fret
forall x. Fret -> Rep Fret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Fret x -> Fret
$cfrom :: forall x. Fret -> Rep Fret x
Generic,Int -> Fret -> ShowS
[Fret] -> ShowS
Fret -> String
(Int -> Fret -> ShowS)
-> (Fret -> String) -> ([Fret] -> ShowS) -> Show Fret
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fret] -> ShowS
$cshowList :: [Fret] -> ShowS
show :: Fret -> String
$cshow :: Fret -> String
showsPrec :: Int -> Fret -> ShowS
$cshowsPrec :: Int -> Fret -> ShowS
Show)
instance EmitXml Fret where
    emitXml :: Fret -> XmlRep
emitXml (Fret NonNegativeInteger
a Maybe CommaSeparatedText
b Maybe FontStyle
c Maybe FontSize
d Maybe FontWeight
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeInteger
a)
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseFret :: P.XParse Fret
parseFret :: XParse Fret
parseFret = 
      NonNegativeInteger
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Fret
Fret
        (NonNegativeInteger
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Fret)
-> XParse NonNegativeInteger
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Fret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Fret)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Fret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Fret)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Fret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Fret)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Fret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Fret)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Fret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Fret) -> XParse (Maybe Color) -> XParse Fret
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Fret'
mkFret :: NonNegativeInteger -> Fret
mkFret :: NonNegativeInteger -> Fret
mkFret NonNegativeInteger
a = NonNegativeInteger
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Fret
Fret NonNegativeInteger
a Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @glass@ /(complex)/
--
-- The glass type represents pictograms for glass percussion instruments. The smufl attribute is used to distinguish different SMuFL glyphs for wind chimes in the chimes pictograms range, including those made of materials other than glass.
data Glass = 
      Glass {
          Glass -> GlassValue
glassGlassValue :: GlassValue -- ^ text content
        , Glass -> Maybe SmuflPictogramGlyphName
glassSmufl :: (Maybe SmuflPictogramGlyphName) -- ^ /smufl/ attribute
       }
    deriving (Glass -> Glass -> Bool
(Glass -> Glass -> Bool) -> (Glass -> Glass -> Bool) -> Eq Glass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glass -> Glass -> Bool
$c/= :: Glass -> Glass -> Bool
== :: Glass -> Glass -> Bool
$c== :: Glass -> Glass -> Bool
Eq,Typeable,(forall x. Glass -> Rep Glass x)
-> (forall x. Rep Glass x -> Glass) -> Generic Glass
forall x. Rep Glass x -> Glass
forall x. Glass -> Rep Glass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Glass x -> Glass
$cfrom :: forall x. Glass -> Rep Glass x
Generic,Int -> Glass -> ShowS
[Glass] -> ShowS
Glass -> String
(Int -> Glass -> ShowS)
-> (Glass -> String) -> ([Glass] -> ShowS) -> Show Glass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glass] -> ShowS
$cshowList :: [Glass] -> ShowS
show :: Glass -> String
$cshow :: Glass -> String
showsPrec :: Int -> Glass -> ShowS
$cshowsPrec :: Int -> Glass -> ShowS
Show)
instance EmitXml Glass where
    emitXml :: Glass -> XmlRep
emitXml (Glass GlassValue
a Maybe SmuflPictogramGlyphName
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (GlassValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GlassValue
a)
        ([XmlRep
-> (SmuflPictogramGlyphName -> XmlRep)
-> Maybe SmuflPictogramGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflPictogramGlyphName -> XmlRep)
-> SmuflPictogramGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflPictogramGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflPictogramGlyphName
b])
        []
parseGlass :: P.XParse Glass
parseGlass :: XParse Glass
parseGlass = 
      GlassValue -> Maybe SmuflPictogramGlyphName -> Glass
Glass
        (GlassValue -> Maybe SmuflPictogramGlyphName -> Glass)
-> XParse GlassValue
-> XParse (Maybe SmuflPictogramGlyphName -> Glass)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse GlassValue) -> XParse GlassValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse GlassValue
parseGlassValue)
        XParse (Maybe SmuflPictogramGlyphName -> Glass)
-> XParse (Maybe SmuflPictogramGlyphName) -> XParse Glass
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflPictogramGlyphName
-> XParse (Maybe SmuflPictogramGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflPictogramGlyphName)
-> XParse SmuflPictogramGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflPictogramGlyphName
parseSmuflPictogramGlyphName)

-- | Smart constructor for 'Glass'
mkGlass :: GlassValue -> Glass
mkGlass :: GlassValue -> Glass
mkGlass GlassValue
a = GlassValue -> Maybe SmuflPictogramGlyphName -> Glass
Glass GlassValue
a Maybe SmuflPictogramGlyphName
forall a. Maybe a
Nothing

-- | @glissando@ /(complex)/
--
-- Glissando and slide types both indicate rapidly moving from one pitch to the other so that individual notes are not discerned. The distinction is similar to that between NIFF's glissando and portamento elements. A glissando sounds the half notes in between the slide and defaults to a wavy line. The optional text is printed alongside the line.
data Glissando = 
      Glissando {
          Glissando -> String
glissandoString :: String -- ^ text content
        , Glissando -> StartStop
glissandoType :: StartStop -- ^ /type/ attribute
        , Glissando -> Maybe NumberLevel
glissandoNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Glissando -> Maybe LineType
glissandoLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Glissando -> Maybe Tenths
glissandoDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Glissando -> Maybe Tenths
glissandoSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Glissando -> Maybe Tenths
glissandoDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Glissando -> Maybe Tenths
glissandoDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Glissando -> Maybe Tenths
glissandoRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Glissando -> Maybe Tenths
glissandoRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Glissando -> Maybe CommaSeparatedText
glissandoFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Glissando -> Maybe FontStyle
glissandoFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Glissando -> Maybe FontSize
glissandoFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Glissando -> Maybe FontWeight
glissandoFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Glissando -> Maybe Color
glissandoColor :: (Maybe Color) -- ^ /color/ attribute
        , Glissando -> Maybe ID
glissandoId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Glissando -> Glissando -> Bool
(Glissando -> Glissando -> Bool)
-> (Glissando -> Glissando -> Bool) -> Eq Glissando
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glissando -> Glissando -> Bool
$c/= :: Glissando -> Glissando -> Bool
== :: Glissando -> Glissando -> Bool
$c== :: Glissando -> Glissando -> Bool
Eq,Typeable,(forall x. Glissando -> Rep Glissando x)
-> (forall x. Rep Glissando x -> Glissando) -> Generic Glissando
forall x. Rep Glissando x -> Glissando
forall x. Glissando -> Rep Glissando x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Glissando x -> Glissando
$cfrom :: forall x. Glissando -> Rep Glissando x
Generic,Int -> Glissando -> ShowS
[Glissando] -> ShowS
Glissando -> String
(Int -> Glissando -> ShowS)
-> (Glissando -> String)
-> ([Glissando] -> ShowS)
-> Show Glissando
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glissando] -> ShowS
$cshowList :: [Glissando] -> ShowS
show :: Glissando -> String
$cshow :: Glissando -> String
showsPrec :: Int -> Glissando -> ShowS
$cshowsPrec :: Int -> Glissando -> ShowS
Show)
instance EmitXml Glissando where
    emitXml :: Glissando -> XmlRep
emitXml (Glissando String
a StartStop
b Maybe NumberLevel
c Maybe LineType
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe CommaSeparatedText
k Maybe FontStyle
l Maybe FontSize
m Maybe FontWeight
n Maybe Color
o Maybe ID
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
p])
        []
parseGlissando :: P.XParse Glissando
parseGlissando :: XParse Glissando
parseGlissando = 
      String
-> StartStop
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> Glissando
Glissando
        (String
 -> StartStop
 -> Maybe NumberLevel
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe ID
 -> Glissando)
-> XParse String
-> XParse
     (StartStop
      -> Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (StartStop
   -> Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse StartStop
-> XParse
     (Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> Glissando)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe ID -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe ID -> Glissando)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe ID -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Maybe ID -> Glissando)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe ID -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe ID -> Glissando)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Glissando)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Glissando)
-> XParse (Maybe ID) -> XParse Glissando
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Glissando'
mkGlissando :: String -> StartStop -> Glissando
mkGlissando :: String -> StartStop -> Glissando
mkGlissando String
a StartStop
b = String
-> StartStop
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> Glissando
Glissando String
a StartStop
b Maybe NumberLevel
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @glyph@ /(complex)/
--
-- The glyph element represents what SMuFL glyph should be used for different variations of symbols that are semantically identical. The type attribute specifies what type of glyph is being defined. The element value specifies what SMuFL glyph to use, including recommended stylistic alternates. The SMuFL glyph name should match the type. For instance, a type of quarter-rest would use values restQuarter, restQuarterOld, or restQuarterZ. A type of g-clef-ottava-bassa would use values gClef8vb, gClef8vbOld, or gClef8vbCClef. A type of octave-shift-up-8 would use values ottava, ottavaBassa, ottavaBassaBa, ottavaBassaVb, or octaveBassa.
data Glyph = 
      Glyph {
          Glyph -> SmuflGlyphName
glyphSmuflGlyphName :: SmuflGlyphName -- ^ text content
        , Glyph -> GlyphType
cmpglyphType :: GlyphType -- ^ /type/ attribute
       }
    deriving (Glyph -> Glyph -> Bool
(Glyph -> Glyph -> Bool) -> (Glyph -> Glyph -> Bool) -> Eq Glyph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Glyph -> Glyph -> Bool
$c/= :: Glyph -> Glyph -> Bool
== :: Glyph -> Glyph -> Bool
$c== :: Glyph -> Glyph -> Bool
Eq,Typeable,(forall x. Glyph -> Rep Glyph x)
-> (forall x. Rep Glyph x -> Glyph) -> Generic Glyph
forall x. Rep Glyph x -> Glyph
forall x. Glyph -> Rep Glyph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Glyph x -> Glyph
$cfrom :: forall x. Glyph -> Rep Glyph x
Generic,Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> String
(Int -> Glyph -> ShowS)
-> (Glyph -> String) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glyph] -> ShowS
$cshowList :: [Glyph] -> ShowS
show :: Glyph -> String
$cshow :: Glyph -> String
showsPrec :: Int -> Glyph -> ShowS
$cshowsPrec :: Int -> Glyph -> ShowS
Show)
instance EmitXml Glyph where
    emitXml :: Glyph -> XmlRep
emitXml (Glyph SmuflGlyphName
a GlyphType
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SmuflGlyphName
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (GlyphType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GlyphType
b)])
        []
parseGlyph :: P.XParse Glyph
parseGlyph :: XParse Glyph
parseGlyph = 
      SmuflGlyphName -> GlyphType -> Glyph
Glyph
        (SmuflGlyphName -> GlyphType -> Glyph)
-> XParse SmuflGlyphName -> XParse (GlyphType -> Glyph)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)
        XParse (GlyphType -> Glyph) -> XParse GlyphType -> XParse Glyph
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse GlyphType) -> XParse GlyphType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse GlyphType
parseGlyphType)

-- | Smart constructor for 'Glyph'
mkGlyph :: SmuflGlyphName -> GlyphType -> Glyph
mkGlyph :: SmuflGlyphName -> GlyphType -> Glyph
mkGlyph SmuflGlyphName
a GlyphType
b = SmuflGlyphName -> GlyphType -> Glyph
Glyph SmuflGlyphName
a GlyphType
b

-- | @grace@ /(complex)/
--
-- The grace type indicates the presence of a grace note. The slash attribute for a grace note is yes for slashed eighth notes. The other grace note attributes come from MuseData sound suggestions. The steal-time-previous attribute indicates the percentage of time to steal from the previous note for the grace note. The steal-time-following attribute indicates the percentage of time to steal from the following note for the grace note, as for appoggiaturas. The make-time attribute indicates to make time, not steal time; the units are in real-time divisions for the grace note.
data Grace = 
      Grace {
          Grace -> Maybe Percent
graceStealTimePrevious :: (Maybe Percent) -- ^ /steal-time-previous/ attribute
        , Grace -> Maybe Percent
graceStealTimeFollowing :: (Maybe Percent) -- ^ /steal-time-following/ attribute
        , Grace -> Maybe Divisions
graceMakeTime :: (Maybe Divisions) -- ^ /make-time/ attribute
        , Grace -> Maybe YesNo
graceSlash :: (Maybe YesNo) -- ^ /slash/ attribute
       }
    deriving (Grace -> Grace -> Bool
(Grace -> Grace -> Bool) -> (Grace -> Grace -> Bool) -> Eq Grace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grace -> Grace -> Bool
$c/= :: Grace -> Grace -> Bool
== :: Grace -> Grace -> Bool
$c== :: Grace -> Grace -> Bool
Eq,Typeable,(forall x. Grace -> Rep Grace x)
-> (forall x. Rep Grace x -> Grace) -> Generic Grace
forall x. Rep Grace x -> Grace
forall x. Grace -> Rep Grace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Grace x -> Grace
$cfrom :: forall x. Grace -> Rep Grace x
Generic,Int -> Grace -> ShowS
[Grace] -> ShowS
Grace -> String
(Int -> Grace -> ShowS)
-> (Grace -> String) -> ([Grace] -> ShowS) -> Show Grace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grace] -> ShowS
$cshowList :: [Grace] -> ShowS
show :: Grace -> String
$cshow :: Grace -> String
showsPrec :: Int -> Grace -> ShowS
$cshowsPrec :: Int -> Grace -> ShowS
Show)
instance EmitXml Grace where
    emitXml :: Grace -> XmlRep
emitXml (Grace Maybe Percent
a Maybe Percent
b Maybe Divisions
c Maybe YesNo
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"steal-time-previous" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"steal-time-following" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"make-time" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"slash" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d])
        []
parseGrace :: P.XParse Grace
parseGrace :: XParse Grace
parseGrace = 
      Maybe Percent
-> Maybe Percent -> Maybe Divisions -> Maybe YesNo -> Grace
Grace
        (Maybe Percent
 -> Maybe Percent -> Maybe Divisions -> Maybe YesNo -> Grace)
-> XParse (Maybe Percent)
-> XParse
     (Maybe Percent -> Maybe Divisions -> Maybe YesNo -> Grace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"steal-time-previous") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Percent -> Maybe Divisions -> Maybe YesNo -> Grace)
-> XParse (Maybe Percent)
-> XParse (Maybe Divisions -> Maybe YesNo -> Grace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"steal-time-following") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Divisions -> Maybe YesNo -> Grace)
-> XParse (Maybe Divisions) -> XParse (Maybe YesNo -> Grace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"make-time") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe YesNo -> Grace)
-> XParse (Maybe YesNo) -> XParse Grace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"slash") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)

-- | Smart constructor for 'Grace'
mkGrace :: Grace
mkGrace :: Grace
mkGrace = Maybe Percent
-> Maybe Percent -> Maybe Divisions -> Maybe YesNo -> Grace
Grace Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing

-- | @group-barline@ /(complex)/
--
-- The group-barline type indicates if the group should have common barlines.
data GroupBarline = 
      GroupBarline {
          GroupBarline -> GroupBarlineValue
groupBarlineGroupBarlineValue :: GroupBarlineValue -- ^ text content
        , GroupBarline -> Maybe Color
groupBarlineColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (GroupBarline -> GroupBarline -> Bool
(GroupBarline -> GroupBarline -> Bool)
-> (GroupBarline -> GroupBarline -> Bool) -> Eq GroupBarline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupBarline -> GroupBarline -> Bool
$c/= :: GroupBarline -> GroupBarline -> Bool
== :: GroupBarline -> GroupBarline -> Bool
$c== :: GroupBarline -> GroupBarline -> Bool
Eq,Typeable,(forall x. GroupBarline -> Rep GroupBarline x)
-> (forall x. Rep GroupBarline x -> GroupBarline)
-> Generic GroupBarline
forall x. Rep GroupBarline x -> GroupBarline
forall x. GroupBarline -> Rep GroupBarline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupBarline x -> GroupBarline
$cfrom :: forall x. GroupBarline -> Rep GroupBarline x
Generic,Int -> GroupBarline -> ShowS
[GroupBarline] -> ShowS
GroupBarline -> String
(Int -> GroupBarline -> ShowS)
-> (GroupBarline -> String)
-> ([GroupBarline] -> ShowS)
-> Show GroupBarline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupBarline] -> ShowS
$cshowList :: [GroupBarline] -> ShowS
show :: GroupBarline -> String
$cshow :: GroupBarline -> String
showsPrec :: Int -> GroupBarline -> ShowS
$cshowsPrec :: Int -> GroupBarline -> ShowS
Show)
instance EmitXml GroupBarline where
    emitXml :: GroupBarline -> XmlRep
emitXml (GroupBarline GroupBarlineValue
a Maybe Color
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (GroupBarlineValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GroupBarlineValue
a)
        ([XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
b])
        []
parseGroupBarline :: P.XParse GroupBarline
parseGroupBarline :: XParse GroupBarline
parseGroupBarline = 
      GroupBarlineValue -> Maybe Color -> GroupBarline
GroupBarline
        (GroupBarlineValue -> Maybe Color -> GroupBarline)
-> XParse GroupBarlineValue -> XParse (Maybe Color -> GroupBarline)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse GroupBarlineValue) -> XParse GroupBarlineValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse GroupBarlineValue
parseGroupBarlineValue)
        XParse (Maybe Color -> GroupBarline)
-> XParse (Maybe Color) -> XParse GroupBarline
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'GroupBarline'
mkGroupBarline :: GroupBarlineValue -> GroupBarline
mkGroupBarline :: GroupBarlineValue -> GroupBarline
mkGroupBarline GroupBarlineValue
a = GroupBarlineValue -> Maybe Color -> GroupBarline
GroupBarline GroupBarlineValue
a Maybe Color
forall a. Maybe a
Nothing

-- | @group-name@ /(complex)/
--
-- The group-name type describes the name or abbreviation of a part-group element. Formatting attributes in the group-name type are deprecated in Version 2.0 in favor of the new group-name-display and group-abbreviation-display elements.
data GroupName = 
      GroupName {
          GroupName -> String
groupNameString :: String -- ^ text content
        , GroupName -> Maybe Tenths
groupNameDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , GroupName -> Maybe Tenths
groupNameDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , GroupName -> Maybe Tenths
groupNameRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , GroupName -> Maybe Tenths
groupNameRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , GroupName -> Maybe CommaSeparatedText
groupNameFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , GroupName -> Maybe FontStyle
groupNameFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , GroupName -> Maybe FontSize
groupNameFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , GroupName -> Maybe FontWeight
groupNameFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , GroupName -> Maybe Color
groupNameColor :: (Maybe Color) -- ^ /color/ attribute
        , GroupName -> Maybe LeftCenterRight
groupNameJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
       }
    deriving (GroupName -> GroupName -> Bool
(GroupName -> GroupName -> Bool)
-> (GroupName -> GroupName -> Bool) -> Eq GroupName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupName -> GroupName -> Bool
$c/= :: GroupName -> GroupName -> Bool
== :: GroupName -> GroupName -> Bool
$c== :: GroupName -> GroupName -> Bool
Eq,Typeable,(forall x. GroupName -> Rep GroupName x)
-> (forall x. Rep GroupName x -> GroupName) -> Generic GroupName
forall x. Rep GroupName x -> GroupName
forall x. GroupName -> Rep GroupName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupName x -> GroupName
$cfrom :: forall x. GroupName -> Rep GroupName x
Generic,Int -> GroupName -> ShowS
[GroupName] -> ShowS
GroupName -> String
(Int -> GroupName -> ShowS)
-> (GroupName -> String)
-> ([GroupName] -> ShowS)
-> Show GroupName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupName] -> ShowS
$cshowList :: [GroupName] -> ShowS
show :: GroupName -> String
$cshow :: GroupName -> String
showsPrec :: Int -> GroupName -> ShowS
$cshowsPrec :: Int -> GroupName -> ShowS
Show)
instance EmitXml GroupName where
    emitXml :: GroupName -> XmlRep
emitXml (GroupName String
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k])
        []
parseGroupName :: P.XParse GroupName
parseGroupName :: XParse GroupName
parseGroupName = 
      String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> GroupName
GroupName
        (String
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> GroupName)
-> XParse String
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> GroupName)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe LeftCenterRight -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe LeftCenterRight -> GroupName)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe LeftCenterRight -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe LeftCenterRight -> GroupName)
-> XParse (Maybe Color)
-> XParse (Maybe LeftCenterRight -> GroupName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> GroupName)
-> XParse (Maybe LeftCenterRight) -> XParse GroupName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)

-- | Smart constructor for 'GroupName'
mkGroupName :: String -> GroupName
mkGroupName :: String -> GroupName
mkGroupName String
a = String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> GroupName
GroupName String
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing

-- | @group-symbol@ /(complex)/
--
-- The group-symbol type indicates how the symbol for a group is indicated in the score.
data GroupSymbol = 
      GroupSymbol {
          GroupSymbol -> GroupSymbolValue
groupSymbolGroupSymbolValue :: GroupSymbolValue -- ^ text content
        , GroupSymbol -> Maybe Tenths
groupSymbolDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , GroupSymbol -> Maybe Tenths
groupSymbolDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , GroupSymbol -> Maybe Tenths
groupSymbolRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , GroupSymbol -> Maybe Tenths
groupSymbolRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , GroupSymbol -> Maybe Color
groupSymbolColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (GroupSymbol -> GroupSymbol -> Bool
(GroupSymbol -> GroupSymbol -> Bool)
-> (GroupSymbol -> GroupSymbol -> Bool) -> Eq GroupSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupSymbol -> GroupSymbol -> Bool
$c/= :: GroupSymbol -> GroupSymbol -> Bool
== :: GroupSymbol -> GroupSymbol -> Bool
$c== :: GroupSymbol -> GroupSymbol -> Bool
Eq,Typeable,(forall x. GroupSymbol -> Rep GroupSymbol x)
-> (forall x. Rep GroupSymbol x -> GroupSymbol)
-> Generic GroupSymbol
forall x. Rep GroupSymbol x -> GroupSymbol
forall x. GroupSymbol -> Rep GroupSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GroupSymbol x -> GroupSymbol
$cfrom :: forall x. GroupSymbol -> Rep GroupSymbol x
Generic,Int -> GroupSymbol -> ShowS
[GroupSymbol] -> ShowS
GroupSymbol -> String
(Int -> GroupSymbol -> ShowS)
-> (GroupSymbol -> String)
-> ([GroupSymbol] -> ShowS)
-> Show GroupSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupSymbol] -> ShowS
$cshowList :: [GroupSymbol] -> ShowS
show :: GroupSymbol -> String
$cshow :: GroupSymbol -> String
showsPrec :: Int -> GroupSymbol -> ShowS
$cshowsPrec :: Int -> GroupSymbol -> ShowS
Show)
instance EmitXml GroupSymbol where
    emitXml :: GroupSymbol -> XmlRep
emitXml (GroupSymbol GroupSymbolValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (GroupSymbolValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GroupSymbolValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseGroupSymbol :: P.XParse GroupSymbol
parseGroupSymbol :: XParse GroupSymbol
parseGroupSymbol = 
      GroupSymbolValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> GroupSymbol
GroupSymbol
        (GroupSymbolValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> GroupSymbol)
-> XParse GroupSymbolValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> GroupSymbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse GroupSymbolValue) -> XParse GroupSymbolValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse GroupSymbolValue
parseGroupSymbolValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> GroupSymbol)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> GroupSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> GroupSymbol)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths -> Maybe Tenths -> Maybe Color -> GroupSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> GroupSymbol)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> GroupSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> GroupSymbol)
-> XParse (Maybe Tenths) -> XParse (Maybe Color -> GroupSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> GroupSymbol)
-> XParse (Maybe Color) -> XParse GroupSymbol
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'GroupSymbol'
mkGroupSymbol :: GroupSymbolValue -> GroupSymbol
mkGroupSymbol :: GroupSymbolValue -> GroupSymbol
mkGroupSymbol GroupSymbolValue
a = GroupSymbolValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> GroupSymbol
GroupSymbol GroupSymbolValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @grouping@ /(complex)/
--
-- The grouping type is used for musical analysis. When the type attribute is "start" or "single", it usually contains one or more feature elements. The number attribute is used for distinguishing between overlapping and hierarchical groupings. The member-of attribute allows for easy distinguishing of what grouping elements are in what hierarchy. Feature elements contained within a "stop" type of grouping may be ignored.
-- 
-- This element is flexible to allow for different types of analyses. Future versions of the MusicXML format may add elements that can represent more standardized categories of analysis data, allowing for easier data sharing.
data Grouping = 
      Grouping {
          Grouping -> StartStopSingle
groupingType :: StartStopSingle -- ^ /type/ attribute
        , Grouping -> Maybe Token
groupingNumber :: (Maybe Token) -- ^ /number/ attribute
        , Grouping -> Maybe Token
groupingMemberOf :: (Maybe Token) -- ^ /member-of/ attribute
        , Grouping -> Maybe ID
groupingId :: (Maybe ID) -- ^ /id/ attribute
        , Grouping -> [Feature]
groupingFeature :: [Feature] -- ^ /feature/ child element
       }
    deriving (Grouping -> Grouping -> Bool
(Grouping -> Grouping -> Bool)
-> (Grouping -> Grouping -> Bool) -> Eq Grouping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grouping -> Grouping -> Bool
$c/= :: Grouping -> Grouping -> Bool
== :: Grouping -> Grouping -> Bool
$c== :: Grouping -> Grouping -> Bool
Eq,Typeable,(forall x. Grouping -> Rep Grouping x)
-> (forall x. Rep Grouping x -> Grouping) -> Generic Grouping
forall x. Rep Grouping x -> Grouping
forall x. Grouping -> Rep Grouping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Grouping x -> Grouping
$cfrom :: forall x. Grouping -> Rep Grouping x
Generic,Int -> Grouping -> ShowS
[Grouping] -> ShowS
Grouping -> String
(Int -> Grouping -> ShowS)
-> (Grouping -> String) -> ([Grouping] -> ShowS) -> Show Grouping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grouping] -> ShowS
$cshowList :: [Grouping] -> ShowS
show :: Grouping -> String
$cshow :: Grouping -> String
showsPrec :: Int -> Grouping -> ShowS
$cshowsPrec :: Int -> Grouping -> ShowS
Show)
instance EmitXml Grouping where
    emitXml :: Grouping -> XmlRep
emitXml (Grouping StartStopSingle
a Maybe Token
b Maybe Token
c Maybe ID
d [Feature]
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopSingle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopSingle
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"member-of" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
d])
        ((Feature -> XmlRep) -> [Feature] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"feature" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Feature -> XmlRep) -> Feature -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Feature -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Feature]
e)
parseGrouping :: P.XParse Grouping
parseGrouping :: XParse Grouping
parseGrouping = 
      StartStopSingle
-> Maybe Token -> Maybe Token -> Maybe ID -> [Feature] -> Grouping
Grouping
        (StartStopSingle
 -> Maybe Token -> Maybe Token -> Maybe ID -> [Feature] -> Grouping)
-> XParse StartStopSingle
-> XParse
     (Maybe Token -> Maybe Token -> Maybe ID -> [Feature] -> Grouping)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopSingle) -> XParse StartStopSingle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopSingle
parseStartStopSingle)
        XParse
  (Maybe Token -> Maybe Token -> Maybe ID -> [Feature] -> Grouping)
-> XParse (Maybe Token)
-> XParse (Maybe Token -> Maybe ID -> [Feature] -> Grouping)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe Token -> Maybe ID -> [Feature] -> Grouping)
-> XParse (Maybe Token)
-> XParse (Maybe ID -> [Feature] -> Grouping)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"member-of") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe ID -> [Feature] -> Grouping)
-> XParse (Maybe ID) -> XParse ([Feature] -> Grouping)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([Feature] -> Grouping)
-> XParse [Feature] -> XParse Grouping
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Feature -> XParse [Feature]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Feature -> XParse Feature
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"feature") (XParse Feature
parseFeature))

-- | Smart constructor for 'Grouping'
mkGrouping :: StartStopSingle -> Grouping
mkGrouping :: StartStopSingle -> Grouping
mkGrouping StartStopSingle
a = StartStopSingle
-> Maybe Token -> Maybe Token -> Maybe ID -> [Feature] -> Grouping
Grouping StartStopSingle
a Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing []

-- | @hammer-on-pull-off@ /(complex)/
--
-- The hammer-on and pull-off elements are used in guitar and fretted instrument notation. Since a single slur can be marked over many notes, the hammer-on and pull-off elements are separate so the individual pair of notes can be specified. The element content can be used to specify how the hammer-on or pull-off should be notated. An empty element leaves this choice up to the application.
data HammerOnPullOff = 
      HammerOnPullOff {
          HammerOnPullOff -> String
hammerOnPullOffString :: String -- ^ text content
        , HammerOnPullOff -> StartStop
hammerOnPullOffType :: StartStop -- ^ /type/ attribute
        , HammerOnPullOff -> Maybe NumberLevel
hammerOnPullOffNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , HammerOnPullOff -> Maybe Tenths
hammerOnPullOffDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , HammerOnPullOff -> Maybe Tenths
hammerOnPullOffDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , HammerOnPullOff -> Maybe Tenths
hammerOnPullOffRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , HammerOnPullOff -> Maybe Tenths
hammerOnPullOffRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , HammerOnPullOff -> Maybe CommaSeparatedText
hammerOnPullOffFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , HammerOnPullOff -> Maybe FontStyle
hammerOnPullOffFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , HammerOnPullOff -> Maybe FontSize
hammerOnPullOffFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , HammerOnPullOff -> Maybe FontWeight
hammerOnPullOffFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , HammerOnPullOff -> Maybe Color
hammerOnPullOffColor :: (Maybe Color) -- ^ /color/ attribute
        , HammerOnPullOff -> Maybe AboveBelow
hammerOnPullOffPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (HammerOnPullOff -> HammerOnPullOff -> Bool
(HammerOnPullOff -> HammerOnPullOff -> Bool)
-> (HammerOnPullOff -> HammerOnPullOff -> Bool)
-> Eq HammerOnPullOff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HammerOnPullOff -> HammerOnPullOff -> Bool
$c/= :: HammerOnPullOff -> HammerOnPullOff -> Bool
== :: HammerOnPullOff -> HammerOnPullOff -> Bool
$c== :: HammerOnPullOff -> HammerOnPullOff -> Bool
Eq,Typeable,(forall x. HammerOnPullOff -> Rep HammerOnPullOff x)
-> (forall x. Rep HammerOnPullOff x -> HammerOnPullOff)
-> Generic HammerOnPullOff
forall x. Rep HammerOnPullOff x -> HammerOnPullOff
forall x. HammerOnPullOff -> Rep HammerOnPullOff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HammerOnPullOff x -> HammerOnPullOff
$cfrom :: forall x. HammerOnPullOff -> Rep HammerOnPullOff x
Generic,Int -> HammerOnPullOff -> ShowS
[HammerOnPullOff] -> ShowS
HammerOnPullOff -> String
(Int -> HammerOnPullOff -> ShowS)
-> (HammerOnPullOff -> String)
-> ([HammerOnPullOff] -> ShowS)
-> Show HammerOnPullOff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HammerOnPullOff] -> ShowS
$cshowList :: [HammerOnPullOff] -> ShowS
show :: HammerOnPullOff -> String
$cshow :: HammerOnPullOff -> String
showsPrec :: Int -> HammerOnPullOff -> ShowS
$cshowsPrec :: Int -> HammerOnPullOff -> ShowS
Show)
instance EmitXml HammerOnPullOff where
    emitXml :: HammerOnPullOff -> XmlRep
emitXml (HammerOnPullOff String
a StartStop
b Maybe NumberLevel
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l Maybe AboveBelow
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
m])
        []
parseHammerOnPullOff :: P.XParse HammerOnPullOff
parseHammerOnPullOff :: XParse HammerOnPullOff
parseHammerOnPullOff = 
      String
-> StartStop
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> HammerOnPullOff
HammerOnPullOff
        (String
 -> StartStop
 -> Maybe NumberLevel
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> HammerOnPullOff)
-> XParse String
-> XParse
     (StartStop
      -> Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (StartStop
   -> Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse StartStop
-> XParse
     (Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HammerOnPullOff)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe AboveBelow -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe AboveBelow -> HammerOnPullOff)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> HammerOnPullOff)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> HammerOnPullOff)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> HammerOnPullOff)
-> XParse (Maybe AboveBelow) -> XParse HammerOnPullOff
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'HammerOnPullOff'
mkHammerOnPullOff :: String -> StartStop -> HammerOnPullOff
mkHammerOnPullOff :: String -> StartStop -> HammerOnPullOff
mkHammerOnPullOff String
a StartStop
b = String
-> StartStop
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> HammerOnPullOff
HammerOnPullOff String
a StartStop
b Maybe NumberLevel
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @handbell@ /(complex)/
--
-- The handbell element represents notation for various techniques used in handbell and handchime music.
data Handbell = 
      Handbell {
          Handbell -> HandbellValue
handbellHandbellValue :: HandbellValue -- ^ text content
        , Handbell -> Maybe Tenths
handbellDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Handbell -> Maybe Tenths
handbellDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Handbell -> Maybe Tenths
handbellRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Handbell -> Maybe Tenths
handbellRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Handbell -> Maybe CommaSeparatedText
handbellFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Handbell -> Maybe FontStyle
handbellFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Handbell -> Maybe FontSize
handbellFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Handbell -> Maybe FontWeight
handbellFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Handbell -> Maybe Color
handbellColor :: (Maybe Color) -- ^ /color/ attribute
        , Handbell -> Maybe AboveBelow
handbellPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (Handbell -> Handbell -> Bool
(Handbell -> Handbell -> Bool)
-> (Handbell -> Handbell -> Bool) -> Eq Handbell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Handbell -> Handbell -> Bool
$c/= :: Handbell -> Handbell -> Bool
== :: Handbell -> Handbell -> Bool
$c== :: Handbell -> Handbell -> Bool
Eq,Typeable,(forall x. Handbell -> Rep Handbell x)
-> (forall x. Rep Handbell x -> Handbell) -> Generic Handbell
forall x. Rep Handbell x -> Handbell
forall x. Handbell -> Rep Handbell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Handbell x -> Handbell
$cfrom :: forall x. Handbell -> Rep Handbell x
Generic,Int -> Handbell -> ShowS
[Handbell] -> ShowS
Handbell -> String
(Int -> Handbell -> ShowS)
-> (Handbell -> String) -> ([Handbell] -> ShowS) -> Show Handbell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Handbell] -> ShowS
$cshowList :: [Handbell] -> ShowS
show :: Handbell -> String
$cshow :: Handbell -> String
showsPrec :: Int -> Handbell -> ShowS
$cshowsPrec :: Int -> Handbell -> ShowS
Show)
instance EmitXml Handbell where
    emitXml :: Handbell -> XmlRep
emitXml (Handbell HandbellValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (HandbellValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HandbellValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        []
parseHandbell :: P.XParse Handbell
parseHandbell :: XParse Handbell
parseHandbell = 
      HandbellValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Handbell
Handbell
        (HandbellValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Handbell)
-> XParse HandbellValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse HandbellValue) -> XParse HandbellValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HandbellValue
parseHandbellValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Handbell)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Handbell)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Handbell)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> Handbell)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> Handbell)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Handbell)
-> XParse (Maybe AboveBelow) -> XParse Handbell
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'Handbell'
mkHandbell :: HandbellValue -> Handbell
mkHandbell :: HandbellValue -> Handbell
mkHandbell HandbellValue
a = HandbellValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Handbell
Handbell HandbellValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @harmon-closed@ /(complex)/
--
-- The harmon-closed type represents whether the harmon mute is closed, open, or half-open. The optional location attribute indicates which portion of the symbol is filled in when the element value is half.
data HarmonClosed = 
      HarmonClosed {
          HarmonClosed -> HarmonClosedValue
harmonClosedHarmonClosedValue :: HarmonClosedValue -- ^ text content
        , HarmonClosed -> Maybe HarmonClosedLocation
harmonClosedLocation :: (Maybe HarmonClosedLocation) -- ^ /location/ attribute
       }
    deriving (HarmonClosed -> HarmonClosed -> Bool
(HarmonClosed -> HarmonClosed -> Bool)
-> (HarmonClosed -> HarmonClosed -> Bool) -> Eq HarmonClosed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonClosed -> HarmonClosed -> Bool
$c/= :: HarmonClosed -> HarmonClosed -> Bool
== :: HarmonClosed -> HarmonClosed -> Bool
$c== :: HarmonClosed -> HarmonClosed -> Bool
Eq,Typeable,(forall x. HarmonClosed -> Rep HarmonClosed x)
-> (forall x. Rep HarmonClosed x -> HarmonClosed)
-> Generic HarmonClosed
forall x. Rep HarmonClosed x -> HarmonClosed
forall x. HarmonClosed -> Rep HarmonClosed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonClosed x -> HarmonClosed
$cfrom :: forall x. HarmonClosed -> Rep HarmonClosed x
Generic,Int -> HarmonClosed -> ShowS
[HarmonClosed] -> ShowS
HarmonClosed -> String
(Int -> HarmonClosed -> ShowS)
-> (HarmonClosed -> String)
-> ([HarmonClosed] -> ShowS)
-> Show HarmonClosed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonClosed] -> ShowS
$cshowList :: [HarmonClosed] -> ShowS
show :: HarmonClosed -> String
$cshow :: HarmonClosed -> String
showsPrec :: Int -> HarmonClosed -> ShowS
$cshowsPrec :: Int -> HarmonClosed -> ShowS
Show)
instance EmitXml HarmonClosed where
    emitXml :: HarmonClosed -> XmlRep
emitXml (HarmonClosed HarmonClosedValue
a Maybe HarmonClosedLocation
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (HarmonClosedValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HarmonClosedValue
a)
        ([XmlRep
-> (HarmonClosedLocation -> XmlRep)
-> Maybe HarmonClosedLocation
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (HarmonClosedLocation -> XmlRep)
-> HarmonClosedLocation
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.HarmonClosedLocation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe HarmonClosedLocation
b])
        []
parseHarmonClosed :: P.XParse HarmonClosed
parseHarmonClosed :: XParse HarmonClosed
parseHarmonClosed = 
      HarmonClosedValue -> Maybe HarmonClosedLocation -> HarmonClosed
HarmonClosed
        (HarmonClosedValue -> Maybe HarmonClosedLocation -> HarmonClosed)
-> XParse HarmonClosedValue
-> XParse (Maybe HarmonClosedLocation -> HarmonClosed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse HarmonClosedValue) -> XParse HarmonClosedValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HarmonClosedValue
parseHarmonClosedValue)
        XParse (Maybe HarmonClosedLocation -> HarmonClosed)
-> XParse (Maybe HarmonClosedLocation) -> XParse HarmonClosed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse HarmonClosedLocation -> XParse (Maybe HarmonClosedLocation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String
-> (String -> XParse HarmonClosedLocation)
-> XParse HarmonClosedLocation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HarmonClosedLocation
parseHarmonClosedLocation)

-- | Smart constructor for 'HarmonClosed'
mkHarmonClosed :: HarmonClosedValue -> HarmonClosed
mkHarmonClosed :: HarmonClosedValue -> HarmonClosed
mkHarmonClosed HarmonClosedValue
a = HarmonClosedValue -> Maybe HarmonClosedLocation -> HarmonClosed
HarmonClosed HarmonClosedValue
a Maybe HarmonClosedLocation
forall a. Maybe a
Nothing

-- | @harmon-mute@ /(complex)/
--
-- The harmon-mute type represents the symbols used for harmon mutes in brass notation.
data HarmonMute = 
      HarmonMute {
          HarmonMute -> Maybe Tenths
harmonMuteDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , HarmonMute -> Maybe Tenths
harmonMuteDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , HarmonMute -> Maybe Tenths
harmonMuteRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , HarmonMute -> Maybe Tenths
harmonMuteRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , HarmonMute -> Maybe CommaSeparatedText
harmonMuteFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , HarmonMute -> Maybe FontStyle
harmonMuteFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , HarmonMute -> Maybe FontSize
harmonMuteFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , HarmonMute -> Maybe FontWeight
harmonMuteFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , HarmonMute -> Maybe Color
harmonMuteColor :: (Maybe Color) -- ^ /color/ attribute
        , HarmonMute -> Maybe AboveBelow
harmonMutePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , HarmonMute -> HarmonClosed
harmonMuteHarmonClosed :: HarmonClosed -- ^ /harmon-closed/ child element
       }
    deriving (HarmonMute -> HarmonMute -> Bool
(HarmonMute -> HarmonMute -> Bool)
-> (HarmonMute -> HarmonMute -> Bool) -> Eq HarmonMute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonMute -> HarmonMute -> Bool
$c/= :: HarmonMute -> HarmonMute -> Bool
== :: HarmonMute -> HarmonMute -> Bool
$c== :: HarmonMute -> HarmonMute -> Bool
Eq,Typeable,(forall x. HarmonMute -> Rep HarmonMute x)
-> (forall x. Rep HarmonMute x -> HarmonMute) -> Generic HarmonMute
forall x. Rep HarmonMute x -> HarmonMute
forall x. HarmonMute -> Rep HarmonMute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonMute x -> HarmonMute
$cfrom :: forall x. HarmonMute -> Rep HarmonMute x
Generic,Int -> HarmonMute -> ShowS
[HarmonMute] -> ShowS
HarmonMute -> String
(Int -> HarmonMute -> ShowS)
-> (HarmonMute -> String)
-> ([HarmonMute] -> ShowS)
-> Show HarmonMute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonMute] -> ShowS
$cshowList :: [HarmonMute] -> ShowS
show :: HarmonMute -> String
$cshow :: HarmonMute -> String
showsPrec :: Int -> HarmonMute -> ShowS
$cshowsPrec :: Int -> HarmonMute -> ShowS
Show)
instance EmitXml HarmonMute where
    emitXml :: HarmonMute -> XmlRep
emitXml (HarmonMute Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j HarmonClosed
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"harmon-closed" Maybe String
forall a. Maybe a
Nothing) (HarmonClosed -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HarmonClosed
k)])
parseHarmonMute :: P.XParse HarmonMute
parseHarmonMute :: XParse HarmonMute
parseHarmonMute = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> HarmonClosed
-> HarmonMute
HarmonMute
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> HarmonClosed
 -> HarmonMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> HarmonClosed
      -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> HarmonClosed
   -> HarmonMute)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe AboveBelow -> HarmonClosed -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe AboveBelow -> HarmonClosed -> HarmonMute)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color -> Maybe AboveBelow -> HarmonClosed -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color -> Maybe AboveBelow -> HarmonClosed -> HarmonMute)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> HarmonClosed -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> HarmonClosed -> HarmonMute)
-> XParse (Maybe AboveBelow) -> XParse (HarmonClosed -> HarmonMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (HarmonClosed -> HarmonMute)
-> XParse HarmonClosed -> XParse HarmonMute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse HarmonClosed -> XParse HarmonClosed
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"harmon-closed") (XParse HarmonClosed
parseHarmonClosed))

-- | Smart constructor for 'HarmonMute'
mkHarmonMute :: HarmonClosed -> HarmonMute
mkHarmonMute :: HarmonClosed -> HarmonMute
mkHarmonMute HarmonClosed
k = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> HarmonClosed
-> HarmonMute
HarmonMute Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing HarmonClosed
k

-- | @harmonic@ /(complex)/
--
-- The harmonic type indicates natural and artificial harmonics. Allowing the type of pitch to be specified, combined with controls for appearance/playback differences, allows both the notation and the sound to be represented. Artificial harmonics can add a notated touching-pitch; artificial pinch harmonics will usually not notate a touching pitch. The attributes for the harmonic element refer to the use of the circular harmonic symbol, typically but not always used with natural harmonics.
data Harmonic = 
      Harmonic {
          Harmonic -> Maybe YesNo
harmonicPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Harmonic -> Maybe Tenths
harmonicDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Harmonic -> Maybe Tenths
harmonicDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Harmonic -> Maybe Tenths
harmonicRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Harmonic -> Maybe Tenths
harmonicRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Harmonic -> Maybe CommaSeparatedText
harmonicFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Harmonic -> Maybe FontStyle
harmonicFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Harmonic -> Maybe FontSize
harmonicFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Harmonic -> Maybe FontWeight
harmonicFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Harmonic -> Maybe Color
harmonicColor :: (Maybe Color) -- ^ /color/ attribute
        , Harmonic -> Maybe AboveBelow
harmonicPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Harmonic -> Maybe ChxHarmonic
harmonicHarmonic :: (Maybe ChxHarmonic)
        , Harmonic -> Maybe ChxHarmonic1
harmonicHarmonic1 :: (Maybe ChxHarmonic1)
       }
    deriving (Harmonic -> Harmonic -> Bool
(Harmonic -> Harmonic -> Bool)
-> (Harmonic -> Harmonic -> Bool) -> Eq Harmonic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Harmonic -> Harmonic -> Bool
$c/= :: Harmonic -> Harmonic -> Bool
== :: Harmonic -> Harmonic -> Bool
$c== :: Harmonic -> Harmonic -> Bool
Eq,Typeable,(forall x. Harmonic -> Rep Harmonic x)
-> (forall x. Rep Harmonic x -> Harmonic) -> Generic Harmonic
forall x. Rep Harmonic x -> Harmonic
forall x. Harmonic -> Rep Harmonic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Harmonic x -> Harmonic
$cfrom :: forall x. Harmonic -> Rep Harmonic x
Generic,Int -> Harmonic -> ShowS
[Harmonic] -> ShowS
Harmonic -> String
(Int -> Harmonic -> ShowS)
-> (Harmonic -> String) -> ([Harmonic] -> ShowS) -> Show Harmonic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Harmonic] -> ShowS
$cshowList :: [Harmonic] -> ShowS
show :: Harmonic -> String
$cshow :: Harmonic -> String
showsPrec :: Int -> Harmonic -> ShowS
$cshowsPrec :: Int -> Harmonic -> ShowS
Show)
instance EmitXml Harmonic where
    emitXml :: Harmonic -> XmlRep
emitXml (Harmonic Maybe YesNo
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k Maybe ChxHarmonic
l Maybe ChxHarmonic1
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        ([Maybe ChxHarmonic -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe ChxHarmonic
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe ChxHarmonic1 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe ChxHarmonic1
m])
parseHarmonic :: P.XParse Harmonic
parseHarmonic :: XParse Harmonic
parseHarmonic = 
      Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ChxHarmonic
-> Maybe ChxHarmonic1
-> Harmonic
Harmonic
        (Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe ChxHarmonic
 -> Maybe ChxHarmonic1
 -> Harmonic)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe ChxHarmonic
      -> Maybe ChxHarmonic1
      -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe ChxHarmonic
   -> Maybe ChxHarmonic1
   -> Harmonic)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe ChxHarmonic -> Maybe ChxHarmonic1 -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe ChxHarmonic -> Maybe ChxHarmonic1 -> Harmonic)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe ChxHarmonic -> Maybe ChxHarmonic1 -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe ChxHarmonic -> Maybe ChxHarmonic1 -> Harmonic)
-> XParse (Maybe ChxHarmonic)
-> XParse (Maybe ChxHarmonic1 -> Harmonic)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxHarmonic -> XParse (Maybe ChxHarmonic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse ChxHarmonic
parseChxHarmonic)
        XParse (Maybe ChxHarmonic1 -> Harmonic)
-> XParse (Maybe ChxHarmonic1) -> XParse Harmonic
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxHarmonic1 -> XParse (Maybe ChxHarmonic1)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse ChxHarmonic1
parseChxHarmonic1)

-- | Smart constructor for 'Harmonic'
mkHarmonic :: Harmonic
mkHarmonic :: Harmonic
mkHarmonic = Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ChxHarmonic
-> Maybe ChxHarmonic1
-> Harmonic
Harmonic Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe ChxHarmonic
forall a. Maybe a
Nothing Maybe ChxHarmonic1
forall a. Maybe a
Nothing

-- | @harmony@ /(complex)/
--
-- The harmony type is based on Humdrum's **harm encoding, extended to support chord symbols in popular music as well as functional harmony analysis in classical music.
-- 
-- If there are alternate harmonies possible, this can be specified using multiple harmony elements differentiated by type. Explicit harmonies have all note present in the music; implied have some notes missing but implied; alternate represents alternate analyses.
-- 
-- The harmony object may be used for analysis or for chord symbols. The print-object attribute controls whether or not anything is printed due to the harmony element. The print-frame attribute controls printing of a frame or fretboard diagram. The print-style attribute group sets the default for the harmony, but individual elements can override this with their own print-style values.
data Harmony = 
      Harmony {
          Harmony -> Maybe HarmonyType
harmonyType :: (Maybe HarmonyType) -- ^ /type/ attribute
        , Harmony -> Maybe YesNo
harmonyPrintFrame :: (Maybe YesNo) -- ^ /print-frame/ attribute
        , Harmony -> Maybe YesNo
harmonyPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Harmony -> Maybe Tenths
harmonyDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Harmony -> Maybe Tenths
harmonyDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Harmony -> Maybe Tenths
harmonyRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Harmony -> Maybe Tenths
harmonyRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Harmony -> Maybe CommaSeparatedText
harmonyFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Harmony -> Maybe FontStyle
harmonyFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Harmony -> Maybe FontSize
harmonyFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Harmony -> Maybe FontWeight
harmonyFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Harmony -> Maybe Color
harmonyColor :: (Maybe Color) -- ^ /color/ attribute
        , Harmony -> Maybe AboveBelow
harmonyPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Harmony -> Maybe ID
harmonyId :: (Maybe ID) -- ^ /id/ attribute
        , Harmony -> [HarmonyChord]
harmonyHarmonyChord :: [HarmonyChord]
        , Harmony -> Maybe Frame
harmonyFrame :: (Maybe Frame) -- ^ /frame/ child element
        , Harmony -> Maybe Offset
harmonyOffset :: (Maybe Offset) -- ^ /offset/ child element
        , Harmony -> Editorial
harmonyEditorial :: Editorial
        , Harmony -> Maybe Staff
harmonyStaff :: (Maybe Staff)
       }
    deriving (Harmony -> Harmony -> Bool
(Harmony -> Harmony -> Bool)
-> (Harmony -> Harmony -> Bool) -> Eq Harmony
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Harmony -> Harmony -> Bool
$c/= :: Harmony -> Harmony -> Bool
== :: Harmony -> Harmony -> Bool
$c== :: Harmony -> Harmony -> Bool
Eq,Typeable,(forall x. Harmony -> Rep Harmony x)
-> (forall x. Rep Harmony x -> Harmony) -> Generic Harmony
forall x. Rep Harmony x -> Harmony
forall x. Harmony -> Rep Harmony x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Harmony x -> Harmony
$cfrom :: forall x. Harmony -> Rep Harmony x
Generic,Int -> Harmony -> ShowS
[Harmony] -> ShowS
Harmony -> String
(Int -> Harmony -> ShowS)
-> (Harmony -> String) -> ([Harmony] -> ShowS) -> Show Harmony
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Harmony] -> ShowS
$cshowList :: [Harmony] -> ShowS
show :: Harmony -> String
$cshow :: Harmony -> String
showsPrec :: Int -> Harmony -> ShowS
$cshowsPrec :: Int -> Harmony -> ShowS
Show)
instance EmitXml Harmony where
    emitXml :: Harmony -> XmlRep
emitXml (Harmony Maybe HarmonyType
a Maybe YesNo
b Maybe YesNo
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l Maybe AboveBelow
m Maybe ID
n [HarmonyChord]
o Maybe Frame
p Maybe Offset
q Editorial
r Maybe Staff
s) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (HarmonyType -> XmlRep) -> Maybe HarmonyType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (HarmonyType -> XmlRep) -> HarmonyType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.HarmonyType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe HarmonyType
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-frame" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
n])
        ([[HarmonyChord] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [HarmonyChord]
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Frame -> XmlRep) -> Maybe Frame -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"frame" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Frame -> XmlRep) -> Frame -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Frame -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Frame
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Offset -> XmlRep) -> Maybe Offset -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"offset" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Offset -> XmlRep) -> Offset -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Offset -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Offset
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe Staff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Staff
s])
parseHarmony :: P.XParse Harmony
parseHarmony :: XParse Harmony
parseHarmony = 
      Maybe HarmonyType
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ID
-> [HarmonyChord]
-> Maybe Frame
-> Maybe Offset
-> Editorial
-> Maybe Staff
-> Harmony
Harmony
        (Maybe HarmonyType
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe ID
 -> [HarmonyChord]
 -> Maybe Frame
 -> Maybe Offset
 -> Editorial
 -> Maybe Staff
 -> Harmony)
-> XParse (Maybe HarmonyType)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse HarmonyType -> XParse (Maybe HarmonyType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse HarmonyType) -> XParse HarmonyType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HarmonyType
parseHarmonyType)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-frame") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe ID
      -> [HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe ID
   -> [HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse (Maybe ID)
-> XParse
     ([HarmonyChord]
      -> Maybe Frame
      -> Maybe Offset
      -> Editorial
      -> Maybe Staff
      -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  ([HarmonyChord]
   -> Maybe Frame
   -> Maybe Offset
   -> Editorial
   -> Maybe Staff
   -> Harmony)
-> XParse [HarmonyChord]
-> XParse
     (Maybe Frame
      -> Maybe Offset -> Editorial -> Maybe Staff -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse HarmonyChord -> XParse [HarmonyChord]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse HarmonyChord
parseHarmonyChord)
        XParse
  (Maybe Frame
   -> Maybe Offset -> Editorial -> Maybe Staff -> Harmony)
-> XParse (Maybe Frame)
-> XParse (Maybe Offset -> Editorial -> Maybe Staff -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Frame -> XParse (Maybe Frame)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Frame -> XParse Frame
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"frame") (XParse Frame
parseFrame))
        XParse (Maybe Offset -> Editorial -> Maybe Staff -> Harmony)
-> XParse (Maybe Offset)
-> XParse (Editorial -> Maybe Staff -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Offset -> XParse (Maybe Offset)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Offset -> XParse Offset
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"offset") (XParse Offset
parseOffset))
        XParse (Editorial -> Maybe Staff -> Harmony)
-> XParse Editorial -> XParse (Maybe Staff -> Harmony)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial
        XParse (Maybe Staff -> Harmony)
-> XParse (Maybe Staff) -> XParse Harmony
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Staff -> XParse (Maybe Staff)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Staff
parseStaff)

-- | Smart constructor for 'Harmony'
mkHarmony :: Editorial -> Harmony
mkHarmony :: Editorial -> Harmony
mkHarmony Editorial
r = Maybe HarmonyType
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe ID
-> [HarmonyChord]
-> Maybe Frame
-> Maybe Offset
-> Editorial
-> Maybe Staff
-> Harmony
Harmony Maybe HarmonyType
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing [] Maybe Frame
forall a. Maybe a
Nothing Maybe Offset
forall a. Maybe a
Nothing Editorial
r Maybe Staff
forall a. Maybe a
Nothing

-- | @harp-pedals@ /(complex)/
--
-- The harp-pedals type is used to create harp pedal diagrams. The pedal-step and pedal-alter elements use the same values as the step and alter elements. For easiest reading, the pedal-tuning elements should follow standard harp pedal order, with pedal-step values of D, C, B, E, F, G, and A.
data HarpPedals = 
      HarpPedals {
          HarpPedals -> Maybe Tenths
harpPedalsDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , HarpPedals -> Maybe Tenths
harpPedalsDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , HarpPedals -> Maybe Tenths
harpPedalsRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , HarpPedals -> Maybe Tenths
harpPedalsRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , HarpPedals -> Maybe CommaSeparatedText
harpPedalsFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , HarpPedals -> Maybe FontStyle
harpPedalsFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , HarpPedals -> Maybe FontSize
harpPedalsFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , HarpPedals -> Maybe FontWeight
harpPedalsFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , HarpPedals -> Maybe Color
harpPedalsColor :: (Maybe Color) -- ^ /color/ attribute
        , HarpPedals -> Maybe LeftCenterRight
harpPedalsHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , HarpPedals -> Maybe Valign
harpPedalsValign :: (Maybe Valign) -- ^ /valign/ attribute
        , HarpPedals -> Maybe ID
harpPedalsId :: (Maybe ID) -- ^ /id/ attribute
        , HarpPedals -> [PedalTuning]
harpPedalsPedalTuning :: [PedalTuning] -- ^ /pedal-tuning/ child element
       }
    deriving (HarpPedals -> HarpPedals -> Bool
(HarpPedals -> HarpPedals -> Bool)
-> (HarpPedals -> HarpPedals -> Bool) -> Eq HarpPedals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarpPedals -> HarpPedals -> Bool
$c/= :: HarpPedals -> HarpPedals -> Bool
== :: HarpPedals -> HarpPedals -> Bool
$c== :: HarpPedals -> HarpPedals -> Bool
Eq,Typeable,(forall x. HarpPedals -> Rep HarpPedals x)
-> (forall x. Rep HarpPedals x -> HarpPedals) -> Generic HarpPedals
forall x. Rep HarpPedals x -> HarpPedals
forall x. HarpPedals -> Rep HarpPedals x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarpPedals x -> HarpPedals
$cfrom :: forall x. HarpPedals -> Rep HarpPedals x
Generic,Int -> HarpPedals -> ShowS
[HarpPedals] -> ShowS
HarpPedals -> String
(Int -> HarpPedals -> ShowS)
-> (HarpPedals -> String)
-> ([HarpPedals] -> ShowS)
-> Show HarpPedals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarpPedals] -> ShowS
$cshowList :: [HarpPedals] -> ShowS
show :: HarpPedals -> String
$cshow :: HarpPedals -> String
showsPrec :: Int -> HarpPedals -> ShowS
$cshowsPrec :: Int -> HarpPedals -> ShowS
Show)
instance EmitXml HarpPedals where
    emitXml :: HarpPedals -> XmlRep
emitXml (HarpPedals Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe LeftCenterRight
j Maybe Valign
k Maybe ID
l [PedalTuning]
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        ((PedalTuning -> XmlRep) -> [PedalTuning] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pedal-tuning" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PedalTuning -> XmlRep) -> PedalTuning -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PedalTuning -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [PedalTuning]
m)
parseHarpPedals :: P.XParse HarpPedals
parseHarpPedals :: XParse HarpPedals
parseHarpPedals = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> [PedalTuning]
-> HarpPedals
HarpPedals
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> [PedalTuning]
 -> HarpPedals)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> [PedalTuning]
      -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> [PedalTuning]
   -> HarpPedals)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign -> Maybe ID -> [PedalTuning] -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign -> Maybe ID -> [PedalTuning] -> HarpPedals)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> [PedalTuning] -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> [PedalTuning] -> HarpPedals)
-> XParse (Maybe Valign)
-> XParse (Maybe ID -> [PedalTuning] -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> [PedalTuning] -> HarpPedals)
-> XParse (Maybe ID) -> XParse ([PedalTuning] -> HarpPedals)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([PedalTuning] -> HarpPedals)
-> XParse [PedalTuning] -> XParse HarpPedals
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PedalTuning -> XParse [PedalTuning]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse PedalTuning -> XParse PedalTuning
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pedal-tuning") (XParse PedalTuning
parsePedalTuning))

-- | Smart constructor for 'HarpPedals'
mkHarpPedals :: HarpPedals
mkHarpPedals :: HarpPedals
mkHarpPedals = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> [PedalTuning]
-> HarpPedals
HarpPedals Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing []

-- | @heel-toe@ /(complex)/
--
-- The heel and toe elements are used with organ pedals. The substitution value is "no" if the attribute is not present.
data HeelToe = 
      HeelToe {
          HeelToe -> HeelToe
heelToeEmptyPlacement :: HeelToe
        , HeelToe -> Maybe YesNo
heelToeSubstitution :: (Maybe YesNo) -- ^ /substitution/ attribute
       }
    deriving (HeelToe -> HeelToe -> Bool
(HeelToe -> HeelToe -> Bool)
-> (HeelToe -> HeelToe -> Bool) -> Eq HeelToe
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeelToe -> HeelToe -> Bool
$c/= :: HeelToe -> HeelToe -> Bool
== :: HeelToe -> HeelToe -> Bool
$c== :: HeelToe -> HeelToe -> Bool
Eq,Typeable,(forall x. HeelToe -> Rep HeelToe x)
-> (forall x. Rep HeelToe x -> HeelToe) -> Generic HeelToe
forall x. Rep HeelToe x -> HeelToe
forall x. HeelToe -> Rep HeelToe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeelToe x -> HeelToe
$cfrom :: forall x. HeelToe -> Rep HeelToe x
Generic,Int -> HeelToe -> ShowS
[HeelToe] -> ShowS
HeelToe -> String
(Int -> HeelToe -> ShowS)
-> (HeelToe -> String) -> ([HeelToe] -> ShowS) -> Show HeelToe
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeelToe] -> ShowS
$cshowList :: [HeelToe] -> ShowS
show :: HeelToe -> String
$cshow :: HeelToe -> String
showsPrec :: Int -> HeelToe -> ShowS
$cshowsPrec :: Int -> HeelToe -> ShowS
Show)
instance EmitXml HeelToe where
    emitXml :: HeelToe -> XmlRep
emitXml (HeelToe HeelToe
a Maybe YesNo
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"substitution" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b])
        ([HeelToe -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HeelToe
a])
parseHeelToe :: P.XParse HeelToe
parseHeelToe :: XParse HeelToe
parseHeelToe = 
      HeelToe -> Maybe YesNo -> HeelToe
HeelToe
        (HeelToe -> Maybe YesNo -> HeelToe)
-> XParse HeelToe -> XParse (Maybe YesNo -> HeelToe)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse HeelToe
parseHeelToe
        XParse (Maybe YesNo -> HeelToe)
-> XParse (Maybe YesNo) -> XParse HeelToe
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"substitution") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)

-- | Smart constructor for 'HeelToe'
mkHeelToe :: HeelToe -> HeelToe
mkHeelToe :: HeelToe -> HeelToe
mkHeelToe HeelToe
a = HeelToe -> Maybe YesNo -> HeelToe
HeelToe HeelToe
a Maybe YesNo
forall a. Maybe a
Nothing

-- | @hole@ /(complex)/
--
-- The hole type represents the symbols used for woodwind and brass fingerings as well as other notations.
data Hole = 
      Hole {
          Hole -> Maybe Tenths
holeDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Hole -> Maybe Tenths
holeDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Hole -> Maybe Tenths
holeRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Hole -> Maybe Tenths
holeRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Hole -> Maybe CommaSeparatedText
holeFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Hole -> Maybe FontStyle
holeFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Hole -> Maybe FontSize
holeFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Hole -> Maybe FontWeight
holeFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Hole -> Maybe Color
holeColor :: (Maybe Color) -- ^ /color/ attribute
        , Hole -> Maybe AboveBelow
holePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Hole -> Maybe String
holeHoleType :: (Maybe String) -- ^ /hole-type/ child element
        , Hole -> HoleClosed
holeHoleClosed :: HoleClosed -- ^ /hole-closed/ child element
        , Hole -> Maybe String
holeHoleShape :: (Maybe String) -- ^ /hole-shape/ child element
       }
    deriving (Hole -> Hole -> Bool
(Hole -> Hole -> Bool) -> (Hole -> Hole -> Bool) -> Eq Hole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hole -> Hole -> Bool
$c/= :: Hole -> Hole -> Bool
== :: Hole -> Hole -> Bool
$c== :: Hole -> Hole -> Bool
Eq,Typeable,(forall x. Hole -> Rep Hole x)
-> (forall x. Rep Hole x -> Hole) -> Generic Hole
forall x. Rep Hole x -> Hole
forall x. Hole -> Rep Hole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hole x -> Hole
$cfrom :: forall x. Hole -> Rep Hole x
Generic,Int -> Hole -> ShowS
[Hole] -> ShowS
Hole -> String
(Int -> Hole -> ShowS)
-> (Hole -> String) -> ([Hole] -> ShowS) -> Show Hole
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hole] -> ShowS
$cshowList :: [Hole] -> ShowS
show :: Hole -> String
$cshow :: Hole -> String
showsPrec :: Int -> Hole -> ShowS
$cshowsPrec :: Int -> Hole -> ShowS
Show)
instance EmitXml Hole where
    emitXml :: Hole -> XmlRep
emitXml (Hole Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe AboveBelow
j Maybe String
k HoleClosed
l Maybe String
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j])
        ([XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"hole-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"hole-closed" Maybe String
forall a. Maybe a
Nothing) (HoleClosed -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HoleClosed
l)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"hole-shape" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
m])
parseHole :: P.XParse Hole
parseHole :: XParse Hole
parseHole = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe String
-> HoleClosed
-> Maybe String
-> Hole
Hole
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe String
 -> HoleClosed
 -> Maybe String
 -> Hole)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe String
      -> HoleClosed
      -> Maybe String
      -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe String
   -> HoleClosed
   -> Maybe String
   -> Hole)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe String -> HoleClosed -> Maybe String -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe String -> HoleClosed -> Maybe String -> Hole)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe String -> HoleClosed -> Maybe String -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe String -> HoleClosed -> Maybe String -> Hole)
-> XParse (Maybe String)
-> XParse (HoleClosed -> Maybe String -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"hole-type") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse (HoleClosed -> Maybe String -> Hole)
-> XParse HoleClosed -> XParse (Maybe String -> Hole)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse HoleClosed -> XParse HoleClosed
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"hole-closed") (XParse HoleClosed
parseHoleClosed))
        XParse (Maybe String -> Hole)
-> XParse (Maybe String) -> XParse Hole
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"hole-shape") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'Hole'
mkHole :: HoleClosed -> Hole
mkHole :: HoleClosed -> Hole
mkHole HoleClosed
l = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe String
-> HoleClosed
-> Maybe String
-> Hole
Hole Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing HoleClosed
l Maybe String
forall a. Maybe a
Nothing

-- | @hole-closed@ /(complex)/
--
-- The hole-closed type represents whether the hole is closed, open, or half-open. The optional location attribute indicates which portion of the hole is filled in when the element value is half.
data HoleClosed = 
      HoleClosed {
          HoleClosed -> HoleClosedValue
holeClosedHoleClosedValue :: HoleClosedValue -- ^ text content
        , HoleClosed -> Maybe HoleClosedLocation
holeClosedLocation :: (Maybe HoleClosedLocation) -- ^ /location/ attribute
       }
    deriving (HoleClosed -> HoleClosed -> Bool
(HoleClosed -> HoleClosed -> Bool)
-> (HoleClosed -> HoleClosed -> Bool) -> Eq HoleClosed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HoleClosed -> HoleClosed -> Bool
$c/= :: HoleClosed -> HoleClosed -> Bool
== :: HoleClosed -> HoleClosed -> Bool
$c== :: HoleClosed -> HoleClosed -> Bool
Eq,Typeable,(forall x. HoleClosed -> Rep HoleClosed x)
-> (forall x. Rep HoleClosed x -> HoleClosed) -> Generic HoleClosed
forall x. Rep HoleClosed x -> HoleClosed
forall x. HoleClosed -> Rep HoleClosed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HoleClosed x -> HoleClosed
$cfrom :: forall x. HoleClosed -> Rep HoleClosed x
Generic,Int -> HoleClosed -> ShowS
[HoleClosed] -> ShowS
HoleClosed -> String
(Int -> HoleClosed -> ShowS)
-> (HoleClosed -> String)
-> ([HoleClosed] -> ShowS)
-> Show HoleClosed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HoleClosed] -> ShowS
$cshowList :: [HoleClosed] -> ShowS
show :: HoleClosed -> String
$cshow :: HoleClosed -> String
showsPrec :: Int -> HoleClosed -> ShowS
$cshowsPrec :: Int -> HoleClosed -> ShowS
Show)
instance EmitXml HoleClosed where
    emitXml :: HoleClosed -> XmlRep
emitXml (HoleClosed HoleClosedValue
a Maybe HoleClosedLocation
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (HoleClosedValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HoleClosedValue
a)
        ([XmlRep
-> (HoleClosedLocation -> XmlRep)
-> Maybe HoleClosedLocation
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (HoleClosedLocation -> XmlRep) -> HoleClosedLocation -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.HoleClosedLocation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe HoleClosedLocation
b])
        []
parseHoleClosed :: P.XParse HoleClosed
parseHoleClosed :: XParse HoleClosed
parseHoleClosed = 
      HoleClosedValue -> Maybe HoleClosedLocation -> HoleClosed
HoleClosed
        (HoleClosedValue -> Maybe HoleClosedLocation -> HoleClosed)
-> XParse HoleClosedValue
-> XParse (Maybe HoleClosedLocation -> HoleClosed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse HoleClosedValue) -> XParse HoleClosedValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HoleClosedValue
parseHoleClosedValue)
        XParse (Maybe HoleClosedLocation -> HoleClosed)
-> XParse (Maybe HoleClosedLocation) -> XParse HoleClosed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse HoleClosedLocation -> XParse (Maybe HoleClosedLocation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String
-> (String -> XParse HoleClosedLocation)
-> XParse HoleClosedLocation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse HoleClosedLocation
parseHoleClosedLocation)

-- | Smart constructor for 'HoleClosed'
mkHoleClosed :: HoleClosedValue -> HoleClosed
mkHoleClosed :: HoleClosedValue -> HoleClosed
mkHoleClosed HoleClosedValue
a = HoleClosedValue -> Maybe HoleClosedLocation -> HoleClosed
HoleClosed HoleClosedValue
a Maybe HoleClosedLocation
forall a. Maybe a
Nothing

-- | @horizontal-turn@ /(complex)/
--
-- The horizontal-turn type represents turn elements that are horizontal rather than vertical. These are empty elements with print-style, placement, trill-sound, and slash attributes. If the slash attribute is yes, then a vertical line is used to slash the turn; it is no by default.
data HorizontalTurn = 
      HorizontalTurn {
          HorizontalTurn -> Maybe YesNo
horizontalTurnSlash :: (Maybe YesNo) -- ^ /slash/ attribute
        , HorizontalTurn -> Maybe Tenths
horizontalTurnDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , HorizontalTurn -> Maybe Tenths
horizontalTurnDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , HorizontalTurn -> Maybe Tenths
horizontalTurnRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , HorizontalTurn -> Maybe Tenths
horizontalTurnRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , HorizontalTurn -> Maybe CommaSeparatedText
horizontalTurnFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , HorizontalTurn -> Maybe FontStyle
horizontalTurnFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , HorizontalTurn -> Maybe FontSize
horizontalTurnFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , HorizontalTurn -> Maybe FontWeight
horizontalTurnFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , HorizontalTurn -> Maybe Color
horizontalTurnColor :: (Maybe Color) -- ^ /color/ attribute
        , HorizontalTurn -> Maybe AboveBelow
horizontalTurnPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , HorizontalTurn -> Maybe StartNote
horizontalTurnStartNote :: (Maybe StartNote) -- ^ /start-note/ attribute
        , HorizontalTurn -> Maybe TrillStep
horizontalTurnTrillStep :: (Maybe TrillStep) -- ^ /trill-step/ attribute
        , HorizontalTurn -> Maybe TwoNoteTurn
horizontalTurnTwoNoteTurn :: (Maybe TwoNoteTurn) -- ^ /two-note-turn/ attribute
        , HorizontalTurn -> Maybe YesNo
horizontalTurnAccelerate :: (Maybe YesNo) -- ^ /accelerate/ attribute
        , HorizontalTurn -> Maybe TrillBeats
horizontalTurnBeats :: (Maybe TrillBeats) -- ^ /beats/ attribute
        , HorizontalTurn -> Maybe Percent
horizontalTurnSecondBeat :: (Maybe Percent) -- ^ /second-beat/ attribute
        , HorizontalTurn -> Maybe Percent
horizontalTurnLastBeat :: (Maybe Percent) -- ^ /last-beat/ attribute
       }
    deriving (HorizontalTurn -> HorizontalTurn -> Bool
(HorizontalTurn -> HorizontalTurn -> Bool)
-> (HorizontalTurn -> HorizontalTurn -> Bool) -> Eq HorizontalTurn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HorizontalTurn -> HorizontalTurn -> Bool
$c/= :: HorizontalTurn -> HorizontalTurn -> Bool
== :: HorizontalTurn -> HorizontalTurn -> Bool
$c== :: HorizontalTurn -> HorizontalTurn -> Bool
Eq,Typeable,(forall x. HorizontalTurn -> Rep HorizontalTurn x)
-> (forall x. Rep HorizontalTurn x -> HorizontalTurn)
-> Generic HorizontalTurn
forall x. Rep HorizontalTurn x -> HorizontalTurn
forall x. HorizontalTurn -> Rep HorizontalTurn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HorizontalTurn x -> HorizontalTurn
$cfrom :: forall x. HorizontalTurn -> Rep HorizontalTurn x
Generic,Int -> HorizontalTurn -> ShowS
[HorizontalTurn] -> ShowS
HorizontalTurn -> String
(Int -> HorizontalTurn -> ShowS)
-> (HorizontalTurn -> String)
-> ([HorizontalTurn] -> ShowS)
-> Show HorizontalTurn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HorizontalTurn] -> ShowS
$cshowList :: [HorizontalTurn] -> ShowS
show :: HorizontalTurn -> String
$cshow :: HorizontalTurn -> String
showsPrec :: Int -> HorizontalTurn -> ShowS
$cshowsPrec :: Int -> HorizontalTurn -> ShowS
Show)
instance EmitXml HorizontalTurn where
    emitXml :: HorizontalTurn -> XmlRep
emitXml (HorizontalTurn Maybe YesNo
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k Maybe StartNote
l Maybe TrillStep
m Maybe TwoNoteTurn
n Maybe YesNo
o Maybe TrillBeats
p Maybe Percent
q Maybe Percent
r) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"slash" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StartNote -> XmlRep) -> Maybe StartNote -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"start-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StartNote -> XmlRep) -> StartNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StartNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StartNote
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillStep -> XmlRep) -> Maybe TrillStep -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"trill-step" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TrillStep -> XmlRep) -> TrillStep -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillStep -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillStep
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TwoNoteTurn -> XmlRep) -> Maybe TwoNoteTurn -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"two-note-turn" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TwoNoteTurn -> XmlRep) -> TwoNoteTurn -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TwoNoteTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TwoNoteTurn
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"accelerate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillBeats -> XmlRep) -> Maybe TrillBeats -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TrillBeats -> XmlRep) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillBeats -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillBeats
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"second-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"last-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
r])
        []
parseHorizontalTurn :: P.XParse HorizontalTurn
parseHorizontalTurn :: XParse HorizontalTurn
parseHorizontalTurn = 
      Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> HorizontalTurn
HorizontalTurn
        (Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe StartNote
 -> Maybe TrillStep
 -> Maybe TwoNoteTurn
 -> Maybe YesNo
 -> Maybe TrillBeats
 -> Maybe Percent
 -> Maybe Percent
 -> HorizontalTurn)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"slash") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe StartNote)
-> XParse
     (Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StartNote -> XParse (Maybe StartNote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"start-note") XParse String -> (String -> XParse StartNote) -> XParse StartNote
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartNote
parseStartNote)
        XParse
  (Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe TrillStep)
-> XParse
     (Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillStep -> XParse (Maybe TrillStep)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"trill-step") XParse String -> (String -> XParse TrillStep) -> XParse TrillStep
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillStep
parseTrillStep)
        XParse
  (Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe TwoNoteTurn)
-> XParse
     (Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TwoNoteTurn -> XParse (Maybe TwoNoteTurn)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"two-note-turn") XParse String
-> (String -> XParse TwoNoteTurn) -> XParse TwoNoteTurn
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TwoNoteTurn
parseTwoNoteTurn)
        XParse
  (Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> HorizontalTurn)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe TrillBeats
      -> Maybe Percent -> Maybe Percent -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"accelerate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe TrillBeats
   -> Maybe Percent -> Maybe Percent -> HorizontalTurn)
-> XParse (Maybe TrillBeats)
-> XParse (Maybe Percent -> Maybe Percent -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillBeats -> XParse (Maybe TrillBeats)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"beats") XParse String -> (String -> XParse TrillBeats) -> XParse TrillBeats
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillBeats
parseTrillBeats)
        XParse (Maybe Percent -> Maybe Percent -> HorizontalTurn)
-> XParse (Maybe Percent)
-> XParse (Maybe Percent -> HorizontalTurn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"second-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Percent -> HorizontalTurn)
-> XParse (Maybe Percent) -> XParse HorizontalTurn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"last-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)

-- | Smart constructor for 'HorizontalTurn'
mkHorizontalTurn :: HorizontalTurn
mkHorizontalTurn :: HorizontalTurn
mkHorizontalTurn = Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> HorizontalTurn
HorizontalTurn Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe StartNote
forall a. Maybe a
Nothing Maybe TrillStep
forall a. Maybe a
Nothing Maybe TwoNoteTurn
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe TrillBeats
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing

-- | @identification@ /(complex)/
--
-- Identification contains basic metadata about the score. It includes the information in MuseData headers that may apply at a score-wide, movement-wide, or part-wide level. The creator, rights, source, and relation elements are based on Dublin Core.
data Identification = 
      Identification {
          Identification -> [TypedText]
identificationCreator :: [TypedText] -- ^ /creator/ child element
        , Identification -> [TypedText]
identificationRights :: [TypedText] -- ^ /rights/ child element
        , Identification -> Maybe Encoding
identificationEncoding :: (Maybe Encoding) -- ^ /encoding/ child element
        , Identification -> Maybe String
identificationSource :: (Maybe String) -- ^ /source/ child element
        , Identification -> [TypedText]
identificationRelation :: [TypedText] -- ^ /relation/ child element
        , Identification -> Maybe Miscellaneous
identificationMiscellaneous :: (Maybe Miscellaneous) -- ^ /miscellaneous/ child element
       }
    deriving (Identification -> Identification -> Bool
(Identification -> Identification -> Bool)
-> (Identification -> Identification -> Bool) -> Eq Identification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identification -> Identification -> Bool
$c/= :: Identification -> Identification -> Bool
== :: Identification -> Identification -> Bool
$c== :: Identification -> Identification -> Bool
Eq,Typeable,(forall x. Identification -> Rep Identification x)
-> (forall x. Rep Identification x -> Identification)
-> Generic Identification
forall x. Rep Identification x -> Identification
forall x. Identification -> Rep Identification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identification x -> Identification
$cfrom :: forall x. Identification -> Rep Identification x
Generic,Int -> Identification -> ShowS
[Identification] -> ShowS
Identification -> String
(Int -> Identification -> ShowS)
-> (Identification -> String)
-> ([Identification] -> ShowS)
-> Show Identification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identification] -> ShowS
$cshowList :: [Identification] -> ShowS
show :: Identification -> String
$cshow :: Identification -> String
showsPrec :: Int -> Identification -> ShowS
$cshowsPrec :: Int -> Identification -> ShowS
Show)
instance EmitXml Identification where
    emitXml :: Identification -> XmlRep
emitXml (Identification [TypedText]
a [TypedText]
b Maybe Encoding
c Maybe String
d [TypedText]
e Maybe Miscellaneous
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((TypedText -> XmlRep) -> [TypedText] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"creator" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TypedText -> XmlRep) -> TypedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TypedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [TypedText]
a [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (TypedText -> XmlRep) -> [TypedText] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"rights" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TypedText -> XmlRep) -> TypedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TypedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [TypedText]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Encoding -> XmlRep) -> Maybe Encoding -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"encoding" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Encoding -> XmlRep) -> Encoding -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Encoding -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Encoding
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"source" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (TypedText -> XmlRep) -> [TypedText] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"relation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TypedText -> XmlRep) -> TypedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TypedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [TypedText]
e [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (Miscellaneous -> XmlRep) -> Maybe Miscellaneous -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"miscellaneous" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Miscellaneous -> XmlRep) -> Miscellaneous -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Miscellaneous -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Miscellaneous
f])
parseIdentification :: P.XParse Identification
parseIdentification :: XParse Identification
parseIdentification = 
      [TypedText]
-> [TypedText]
-> Maybe Encoding
-> Maybe String
-> [TypedText]
-> Maybe Miscellaneous
-> Identification
Identification
        ([TypedText]
 -> [TypedText]
 -> Maybe Encoding
 -> Maybe String
 -> [TypedText]
 -> Maybe Miscellaneous
 -> Identification)
-> XParse [TypedText]
-> XParse
     ([TypedText]
      -> Maybe Encoding
      -> Maybe String
      -> [TypedText]
      -> Maybe Miscellaneous
      -> Identification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TypedText -> XParse [TypedText]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse TypedText -> XParse TypedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"creator") (XParse TypedText
parseTypedText))
        XParse
  ([TypedText]
   -> Maybe Encoding
   -> Maybe String
   -> [TypedText]
   -> Maybe Miscellaneous
   -> Identification)
-> XParse [TypedText]
-> XParse
     (Maybe Encoding
      -> Maybe String
      -> [TypedText]
      -> Maybe Miscellaneous
      -> Identification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TypedText -> XParse [TypedText]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse TypedText -> XParse TypedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"rights") (XParse TypedText
parseTypedText))
        XParse
  (Maybe Encoding
   -> Maybe String
   -> [TypedText]
   -> Maybe Miscellaneous
   -> Identification)
-> XParse (Maybe Encoding)
-> XParse
     (Maybe String
      -> [TypedText] -> Maybe Miscellaneous -> Identification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Encoding -> XParse (Maybe Encoding)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Encoding -> XParse Encoding
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"encoding") (XParse Encoding
parseEncoding))
        XParse
  (Maybe String
   -> [TypedText] -> Maybe Miscellaneous -> Identification)
-> XParse (Maybe String)
-> XParse ([TypedText] -> Maybe Miscellaneous -> Identification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"source") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse ([TypedText] -> Maybe Miscellaneous -> Identification)
-> XParse [TypedText]
-> XParse (Maybe Miscellaneous -> Identification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TypedText -> XParse [TypedText]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse TypedText -> XParse TypedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"relation") (XParse TypedText
parseTypedText))
        XParse (Maybe Miscellaneous -> Identification)
-> XParse (Maybe Miscellaneous) -> XParse Identification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Miscellaneous -> XParse (Maybe Miscellaneous)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Miscellaneous -> XParse Miscellaneous
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"miscellaneous") (XParse Miscellaneous
parseMiscellaneous))

-- | Smart constructor for 'Identification'
mkIdentification :: Identification
mkIdentification :: Identification
mkIdentification = [TypedText]
-> [TypedText]
-> Maybe Encoding
-> Maybe String
-> [TypedText]
-> Maybe Miscellaneous
-> Identification
Identification [] [] Maybe Encoding
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing [] Maybe Miscellaneous
forall a. Maybe a
Nothing

-- | @image@ /(complex)/
--
-- The image type is used to include graphical images in a score.
data Image = 
      Image {
          Image -> String
imageSource :: String -- ^ /source/ attribute
        , Image -> Token
imageType :: Token -- ^ /type/ attribute
        , Image -> Maybe Tenths
imageHeight :: (Maybe Tenths) -- ^ /height/ attribute
        , Image -> Maybe Tenths
imageWidth :: (Maybe Tenths) -- ^ /width/ attribute
        , Image -> Maybe Tenths
imageDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Image -> Maybe Tenths
imageDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Image -> Maybe Tenths
imageRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Image -> Maybe Tenths
imageRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Image -> Maybe LeftCenterRight
imageHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Image -> Maybe ValignImage
imageValign :: (Maybe ValignImage) -- ^ /valign/ attribute
        , Image -> Maybe ID
imageId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq,Typeable,(forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic,Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show)
instance EmitXml Image where
    emitXml :: Image -> XmlRep
emitXml (Image String
a Token
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe LeftCenterRight
i Maybe ValignImage
j Maybe ID
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"source" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"height" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"width" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ValignImage -> XmlRep) -> Maybe ValignImage -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ValignImage -> XmlRep) -> ValignImage -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ValignImage -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ValignImage
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
k])
        []
parseImage :: P.XParse Image
parseImage :: XParse Image
parseImage = 
      String
-> Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe LeftCenterRight
-> Maybe ValignImage
-> Maybe ID
-> Image
Image
        (String
 -> Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe LeftCenterRight
 -> Maybe ValignImage
 -> Maybe ID
 -> Image)
-> XParse String
-> XParse
     (Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"source") XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse Token
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"height") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"width") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe LeftCenterRight
      -> Maybe ValignImage
      -> Maybe ID
      -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe LeftCenterRight
   -> Maybe ValignImage
   -> Maybe ID
   -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe LeftCenterRight -> Maybe ValignImage -> Maybe ID -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe LeftCenterRight -> Maybe ValignImage -> Maybe ID -> Image)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe LeftCenterRight -> Maybe ValignImage -> Maybe ID -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe LeftCenterRight -> Maybe ValignImage -> Maybe ID -> Image)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe ValignImage -> Maybe ID -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe ValignImage -> Maybe ID -> Image)
-> XParse (Maybe ValignImage) -> XParse (Maybe ID -> Image)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ValignImage -> XParse (Maybe ValignImage)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String
-> (String -> XParse ValignImage) -> XParse ValignImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ValignImage
parseValignImage)
        XParse (Maybe ID -> Image) -> XParse (Maybe ID) -> XParse Image
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Image'
mkImage :: String -> Token -> Image
mkImage :: String -> Token -> Image
mkImage String
a Token
b = String
-> Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe LeftCenterRight
-> Maybe ValignImage
-> Maybe ID
-> Image
Image String
a Token
b Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe ValignImage
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @instrument@ /(complex)/
--
-- The instrument type distinguishes between score-instrument elements in a score-part. The id attribute is an IDREF back to the score-instrument ID. If multiple score-instruments are specified on a score-part, there should be an instrument element for each note in the part.
data Instrument = 
      Instrument {
          Instrument -> IDREF
instrumentId :: IDREF -- ^ /id/ attribute
       }
    deriving (Instrument -> Instrument -> Bool
(Instrument -> Instrument -> Bool)
-> (Instrument -> Instrument -> Bool) -> Eq Instrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instrument -> Instrument -> Bool
$c/= :: Instrument -> Instrument -> Bool
== :: Instrument -> Instrument -> Bool
$c== :: Instrument -> Instrument -> Bool
Eq,Typeable,(forall x. Instrument -> Rep Instrument x)
-> (forall x. Rep Instrument x -> Instrument) -> Generic Instrument
forall x. Rep Instrument x -> Instrument
forall x. Instrument -> Rep Instrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instrument x -> Instrument
$cfrom :: forall x. Instrument -> Rep Instrument x
Generic,Int -> Instrument -> ShowS
[Instrument] -> ShowS
Instrument -> String
(Int -> Instrument -> ShowS)
-> (Instrument -> String)
-> ([Instrument] -> ShowS)
-> Show Instrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instrument] -> ShowS
$cshowList :: [Instrument] -> ShowS
show :: Instrument -> String
$cshow :: Instrument -> String
showsPrec :: Int -> Instrument -> ShowS
$cshowsPrec :: Int -> Instrument -> ShowS
Show)
instance EmitXml Instrument where
    emitXml :: Instrument -> XmlRep
emitXml (Instrument IDREF
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml IDREF
a)])
        []
parseInstrument :: P.XParse Instrument
parseInstrument :: XParse Instrument
parseInstrument = 
      IDREF -> Instrument
Instrument
        (IDREF -> Instrument) -> XParse IDREF -> XParse Instrument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)

-- | Smart constructor for 'Instrument'
mkInstrument :: IDREF -> Instrument
mkInstrument :: IDREF -> Instrument
mkInstrument IDREF
a = IDREF -> Instrument
Instrument IDREF
a

-- | @interchangeable@ /(complex)/
--
-- The interchangeable type is used to represent the second in a pair of interchangeable dual time signatures, such as the 6/8 in 3/4 (6/8). A separate symbol attribute value is available compared to the time element's symbol attribute, which applies to the first of the dual time signatures.
data Interchangeable = 
      Interchangeable {
          Interchangeable -> Maybe TimeSymbol
interchangeableSymbol :: (Maybe TimeSymbol) -- ^ /symbol/ attribute
        , Interchangeable -> Maybe TimeSeparator
interchangeableSeparator :: (Maybe TimeSeparator) -- ^ /separator/ attribute
        , Interchangeable -> Maybe TimeRelation
interchangeableTimeRelation :: (Maybe TimeRelation) -- ^ /time-relation/ child element
        , Interchangeable -> [TimeSignature]
interchangeableTimeSignature :: [TimeSignature]
       }
    deriving (Interchangeable -> Interchangeable -> Bool
(Interchangeable -> Interchangeable -> Bool)
-> (Interchangeable -> Interchangeable -> Bool)
-> Eq Interchangeable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interchangeable -> Interchangeable -> Bool
$c/= :: Interchangeable -> Interchangeable -> Bool
== :: Interchangeable -> Interchangeable -> Bool
$c== :: Interchangeable -> Interchangeable -> Bool
Eq,Typeable,(forall x. Interchangeable -> Rep Interchangeable x)
-> (forall x. Rep Interchangeable x -> Interchangeable)
-> Generic Interchangeable
forall x. Rep Interchangeable x -> Interchangeable
forall x. Interchangeable -> Rep Interchangeable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Interchangeable x -> Interchangeable
$cfrom :: forall x. Interchangeable -> Rep Interchangeable x
Generic,Int -> Interchangeable -> ShowS
[Interchangeable] -> ShowS
Interchangeable -> String
(Int -> Interchangeable -> ShowS)
-> (Interchangeable -> String)
-> ([Interchangeable] -> ShowS)
-> Show Interchangeable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interchangeable] -> ShowS
$cshowList :: [Interchangeable] -> ShowS
show :: Interchangeable -> String
$cshow :: Interchangeable -> String
showsPrec :: Int -> Interchangeable -> ShowS
$cshowsPrec :: Int -> Interchangeable -> ShowS
Show)
instance EmitXml Interchangeable where
    emitXml :: Interchangeable -> XmlRep
emitXml (Interchangeable Maybe TimeSymbol
a Maybe TimeSeparator
b Maybe TimeRelation
c [TimeSignature]
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (TimeSymbol -> XmlRep) -> Maybe TimeSymbol -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"symbol" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeSymbol -> XmlRep) -> TimeSymbol -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeSymbol
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TimeSeparator -> XmlRep) -> Maybe TimeSeparator -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"separator" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeSeparator -> XmlRep) -> TimeSeparator -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeSeparator -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeSeparator
b])
        ([XmlRep -> (TimeRelation -> XmlRep) -> Maybe TimeRelation -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"time-relation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeRelation -> XmlRep) -> TimeRelation -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeRelation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeRelation
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [[TimeSignature] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [TimeSignature]
d])
parseInterchangeable :: P.XParse Interchangeable
parseInterchangeable :: XParse Interchangeable
parseInterchangeable = 
      Maybe TimeSymbol
-> Maybe TimeSeparator
-> Maybe TimeRelation
-> [TimeSignature]
-> Interchangeable
Interchangeable
        (Maybe TimeSymbol
 -> Maybe TimeSeparator
 -> Maybe TimeRelation
 -> [TimeSignature]
 -> Interchangeable)
-> XParse (Maybe TimeSymbol)
-> XParse
     (Maybe TimeSeparator
      -> Maybe TimeRelation -> [TimeSignature] -> Interchangeable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TimeSymbol -> XParse (Maybe TimeSymbol)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"symbol") XParse String -> (String -> XParse TimeSymbol) -> XParse TimeSymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeSymbol
parseTimeSymbol)
        XParse
  (Maybe TimeSeparator
   -> Maybe TimeRelation -> [TimeSignature] -> Interchangeable)
-> XParse (Maybe TimeSeparator)
-> XParse
     (Maybe TimeRelation -> [TimeSignature] -> Interchangeable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeSeparator -> XParse (Maybe TimeSeparator)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"separator") XParse String
-> (String -> XParse TimeSeparator) -> XParse TimeSeparator
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeSeparator
parseTimeSeparator)
        XParse (Maybe TimeRelation -> [TimeSignature] -> Interchangeable)
-> XParse (Maybe TimeRelation)
-> XParse ([TimeSignature] -> Interchangeable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeRelation -> XParse (Maybe TimeRelation)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TimeRelation -> XParse TimeRelation
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"time-relation") (XParse String
P.xtext XParse String
-> (String -> XParse TimeRelation) -> XParse TimeRelation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeRelation
parseTimeRelation))
        XParse ([TimeSignature] -> Interchangeable)
-> XParse [TimeSignature] -> XParse Interchangeable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeSignature -> XParse [TimeSignature]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse TimeSignature
parseTimeSignature)

-- | Smart constructor for 'Interchangeable'
mkInterchangeable :: Interchangeable
mkInterchangeable :: Interchangeable
mkInterchangeable = Maybe TimeSymbol
-> Maybe TimeSeparator
-> Maybe TimeRelation
-> [TimeSignature]
-> Interchangeable
Interchangeable Maybe TimeSymbol
forall a. Maybe a
Nothing Maybe TimeSeparator
forall a. Maybe a
Nothing Maybe TimeRelation
forall a. Maybe a
Nothing []

-- | @inversion@ /(complex)/
--
-- The inversion type represents harmony inversions. The value is a number indicating which inversion is used: 0 for root position, 1 for first inversion, etc.
data Inversion = 
      Inversion {
          Inversion -> NonNegativeInteger
inversionNonNegativeInteger :: NonNegativeInteger -- ^ text content
        , Inversion -> Maybe Tenths
inversionDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Inversion -> Maybe Tenths
inversionDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Inversion -> Maybe Tenths
inversionRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Inversion -> Maybe Tenths
inversionRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Inversion -> Maybe CommaSeparatedText
inversionFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Inversion -> Maybe FontStyle
inversionFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Inversion -> Maybe FontSize
inversionFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Inversion -> Maybe FontWeight
inversionFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Inversion -> Maybe Color
inversionColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Inversion -> Inversion -> Bool
(Inversion -> Inversion -> Bool)
-> (Inversion -> Inversion -> Bool) -> Eq Inversion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inversion -> Inversion -> Bool
$c/= :: Inversion -> Inversion -> Bool
== :: Inversion -> Inversion -> Bool
$c== :: Inversion -> Inversion -> Bool
Eq,Typeable,(forall x. Inversion -> Rep Inversion x)
-> (forall x. Rep Inversion x -> Inversion) -> Generic Inversion
forall x. Rep Inversion x -> Inversion
forall x. Inversion -> Rep Inversion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Inversion x -> Inversion
$cfrom :: forall x. Inversion -> Rep Inversion x
Generic,Int -> Inversion -> ShowS
[Inversion] -> ShowS
Inversion -> String
(Int -> Inversion -> ShowS)
-> (Inversion -> String)
-> ([Inversion] -> ShowS)
-> Show Inversion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inversion] -> ShowS
$cshowList :: [Inversion] -> ShowS
show :: Inversion -> String
$cshow :: Inversion -> String
showsPrec :: Int -> Inversion -> ShowS
$cshowsPrec :: Int -> Inversion -> ShowS
Show)
instance EmitXml Inversion where
    emitXml :: Inversion -> XmlRep
emitXml (Inversion NonNegativeInteger
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeInteger
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j])
        []
parseInversion :: P.XParse Inversion
parseInversion :: XParse Inversion
parseInversion = 
      NonNegativeInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Inversion
Inversion
        (NonNegativeInteger
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Inversion)
-> XParse NonNegativeInteger
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Inversion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Inversion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Inversion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Inversion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Inversion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Inversion)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Inversion)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> Inversion)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Inversion)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> Inversion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Inversion)
-> XParse (Maybe Color) -> XParse Inversion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Inversion'
mkInversion :: NonNegativeInteger -> Inversion
mkInversion :: NonNegativeInteger -> Inversion
mkInversion NonNegativeInteger
a = NonNegativeInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Inversion
Inversion NonNegativeInteger
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @key@ /(complex)/
--
-- The key type represents a key signature. Both traditional and non-traditional key signatures are supported. The optional number attribute refers to staff numbers. If absent, the key signature applies to all staves in the part. Key signatures appear at the start of each system unless the print-object attribute has been set to "no".
data Key = 
      Key {
          Key -> Maybe StaffNumber
keyNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , Key -> Maybe Tenths
keyDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Key -> Maybe Tenths
keyDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Key -> Maybe Tenths
keyRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Key -> Maybe Tenths
keyRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Key -> Maybe CommaSeparatedText
keyFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Key -> Maybe FontStyle
keyFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Key -> Maybe FontSize
keyFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Key -> Maybe FontWeight
keyFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Key -> Maybe Color
keyColor :: (Maybe Color) -- ^ /color/ attribute
        , Key -> Maybe YesNo
keyPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Key -> Maybe ID
keyId :: (Maybe ID) -- ^ /id/ attribute
        , Key -> ChxKey
keyKey :: ChxKey
        , Key -> [KeyOctave]
keyKeyOctave :: [KeyOctave] -- ^ /key-octave/ child element
       }
    deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq,Typeable,(forall x. Key -> Rep Key x)
-> (forall x. Rep Key x -> Key) -> Generic Key
forall x. Rep Key x -> Key
forall x. Key -> Rep Key x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Key x -> Key
$cfrom :: forall x. Key -> Rep Key x
Generic,Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
instance EmitXml Key where
    emitXml :: Key -> XmlRep
emitXml (Key Maybe StaffNumber
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe YesNo
k Maybe ID
l ChxKey
m [KeyOctave]
n) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        ([ChxKey -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxKey
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (KeyOctave -> XmlRep) -> [KeyOctave] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"key-octave" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (KeyOctave -> XmlRep) -> KeyOctave -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.KeyOctave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [KeyOctave]
n)
parseKey :: P.XParse Key
parseKey :: XParse Key
parseKey = 
      Maybe StaffNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ChxKey
-> [KeyOctave]
-> Key
Key
        (Maybe StaffNumber
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe ID
 -> ChxKey
 -> [KeyOctave]
 -> Key)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxKey
      -> [KeyOctave]
      -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxKey
   -> [KeyOctave]
   -> Key)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo -> Maybe ID -> ChxKey -> [KeyOctave] -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo -> Maybe ID -> ChxKey -> [KeyOctave] -> Key)
-> XParse (Maybe Color)
-> XParse (Maybe YesNo -> Maybe ID -> ChxKey -> [KeyOctave] -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe YesNo -> Maybe ID -> ChxKey -> [KeyOctave] -> Key)
-> XParse (Maybe YesNo)
-> XParse (Maybe ID -> ChxKey -> [KeyOctave] -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe ID -> ChxKey -> [KeyOctave] -> Key)
-> XParse (Maybe ID) -> XParse (ChxKey -> [KeyOctave] -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxKey -> [KeyOctave] -> Key)
-> XParse ChxKey -> XParse ([KeyOctave] -> Key)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxKey
parseChxKey
        XParse ([KeyOctave] -> Key) -> XParse [KeyOctave] -> XParse Key
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse KeyOctave -> XParse [KeyOctave]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse KeyOctave -> XParse KeyOctave
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"key-octave") (XParse KeyOctave
parseKeyOctave))

-- | Smart constructor for 'Key'
mkKey :: ChxKey -> Key
mkKey :: ChxKey -> Key
mkKey ChxKey
m = Maybe StaffNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ChxKey
-> [KeyOctave]
-> Key
Key Maybe StaffNumber
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxKey
m []

-- | @key-accidental@ /(complex)/
--
-- The key-accidental type indicates the accidental to be displayed in a non-traditional key signature, represented in the same manner as the accidental type without the formatting attributes.
data KeyAccidental = 
      KeyAccidental {
          KeyAccidental -> AccidentalValue
keyAccidentalAccidentalValue :: AccidentalValue -- ^ text content
        , KeyAccidental -> Maybe SmuflAccidentalGlyphName
keyAccidentalSmufl :: (Maybe SmuflAccidentalGlyphName) -- ^ /smufl/ attribute
       }
    deriving (KeyAccidental -> KeyAccidental -> Bool
(KeyAccidental -> KeyAccidental -> Bool)
-> (KeyAccidental -> KeyAccidental -> Bool) -> Eq KeyAccidental
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyAccidental -> KeyAccidental -> Bool
$c/= :: KeyAccidental -> KeyAccidental -> Bool
== :: KeyAccidental -> KeyAccidental -> Bool
$c== :: KeyAccidental -> KeyAccidental -> Bool
Eq,Typeable,(forall x. KeyAccidental -> Rep KeyAccidental x)
-> (forall x. Rep KeyAccidental x -> KeyAccidental)
-> Generic KeyAccidental
forall x. Rep KeyAccidental x -> KeyAccidental
forall x. KeyAccidental -> Rep KeyAccidental x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyAccidental x -> KeyAccidental
$cfrom :: forall x. KeyAccidental -> Rep KeyAccidental x
Generic,Int -> KeyAccidental -> ShowS
[KeyAccidental] -> ShowS
KeyAccidental -> String
(Int -> KeyAccidental -> ShowS)
-> (KeyAccidental -> String)
-> ([KeyAccidental] -> ShowS)
-> Show KeyAccidental
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyAccidental] -> ShowS
$cshowList :: [KeyAccidental] -> ShowS
show :: KeyAccidental -> String
$cshow :: KeyAccidental -> String
showsPrec :: Int -> KeyAccidental -> ShowS
$cshowsPrec :: Int -> KeyAccidental -> ShowS
Show)
instance EmitXml KeyAccidental where
    emitXml :: KeyAccidental -> XmlRep
emitXml (KeyAccidental AccidentalValue
a Maybe SmuflAccidentalGlyphName
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (AccidentalValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalValue
a)
        ([XmlRep
-> (SmuflAccidentalGlyphName -> XmlRep)
-> Maybe SmuflAccidentalGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflAccidentalGlyphName -> XmlRep)
-> SmuflAccidentalGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflAccidentalGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflAccidentalGlyphName
b])
        []
parseKeyAccidental :: P.XParse KeyAccidental
parseKeyAccidental :: XParse KeyAccidental
parseKeyAccidental = 
      AccidentalValue -> Maybe SmuflAccidentalGlyphName -> KeyAccidental
KeyAccidental
        (AccidentalValue
 -> Maybe SmuflAccidentalGlyphName -> KeyAccidental)
-> XParse AccidentalValue
-> XParse (Maybe SmuflAccidentalGlyphName -> KeyAccidental)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse AccidentalValue) -> XParse AccidentalValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AccidentalValue
parseAccidentalValue)
        XParse (Maybe SmuflAccidentalGlyphName -> KeyAccidental)
-> XParse (Maybe SmuflAccidentalGlyphName) -> XParse KeyAccidental
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflAccidentalGlyphName
-> XParse (Maybe SmuflAccidentalGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflAccidentalGlyphName)
-> XParse SmuflAccidentalGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflAccidentalGlyphName
parseSmuflAccidentalGlyphName)

-- | Smart constructor for 'KeyAccidental'
mkKeyAccidental :: AccidentalValue -> KeyAccidental
mkKeyAccidental :: AccidentalValue -> KeyAccidental
mkKeyAccidental AccidentalValue
a = AccidentalValue -> Maybe SmuflAccidentalGlyphName -> KeyAccidental
KeyAccidental AccidentalValue
a Maybe SmuflAccidentalGlyphName
forall a. Maybe a
Nothing

-- | @key-octave@ /(complex)/
--
-- The key-octave element specifies in which octave an element of a key signature appears. The content specifies the octave value using the same values as the display-octave element. The number attribute is a positive integer that refers to the key signature element in left-to-right order. If the cancel attribute is set to yes, then this number refers to the canceling key signature specified by the cancel element in the parent key element. The cancel attribute cannot be set to yes if there is no corresponding cancel element within the parent key element. It is no by default.
data KeyOctave = 
      KeyOctave {
          KeyOctave -> Octave
keyOctaveOctave :: Octave -- ^ text content
        , KeyOctave -> PositiveInteger
keyOctaveNumber :: PositiveInteger -- ^ /number/ attribute
        , KeyOctave -> Maybe YesNo
keyOctaveCancel :: (Maybe YesNo) -- ^ /cancel/ attribute
       }
    deriving (KeyOctave -> KeyOctave -> Bool
(KeyOctave -> KeyOctave -> Bool)
-> (KeyOctave -> KeyOctave -> Bool) -> Eq KeyOctave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyOctave -> KeyOctave -> Bool
$c/= :: KeyOctave -> KeyOctave -> Bool
== :: KeyOctave -> KeyOctave -> Bool
$c== :: KeyOctave -> KeyOctave -> Bool
Eq,Typeable,(forall x. KeyOctave -> Rep KeyOctave x)
-> (forall x. Rep KeyOctave x -> KeyOctave) -> Generic KeyOctave
forall x. Rep KeyOctave x -> KeyOctave
forall x. KeyOctave -> Rep KeyOctave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyOctave x -> KeyOctave
$cfrom :: forall x. KeyOctave -> Rep KeyOctave x
Generic,Int -> KeyOctave -> ShowS
[KeyOctave] -> ShowS
KeyOctave -> String
(Int -> KeyOctave -> ShowS)
-> (KeyOctave -> String)
-> ([KeyOctave] -> ShowS)
-> Show KeyOctave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyOctave] -> ShowS
$cshowList :: [KeyOctave] -> ShowS
show :: KeyOctave -> String
$cshow :: KeyOctave -> String
showsPrec :: Int -> KeyOctave -> ShowS
$cshowsPrec :: Int -> KeyOctave -> ShowS
Show)
instance EmitXml KeyOctave where
    emitXml :: KeyOctave -> XmlRep
emitXml (KeyOctave Octave
a PositiveInteger
b Maybe YesNo
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Octave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Octave
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing) (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"cancel" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c])
        []
parseKeyOctave :: P.XParse KeyOctave
parseKeyOctave :: XParse KeyOctave
parseKeyOctave = 
      Octave -> PositiveInteger -> Maybe YesNo -> KeyOctave
KeyOctave
        (Octave -> PositiveInteger -> Maybe YesNo -> KeyOctave)
-> XParse Octave
-> XParse (PositiveInteger -> Maybe YesNo -> KeyOctave)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Octave) -> XParse Octave
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Octave
parseOctave)
        XParse (PositiveInteger -> Maybe YesNo -> KeyOctave)
-> XParse PositiveInteger -> XParse (Maybe YesNo -> KeyOctave)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse (Maybe YesNo -> KeyOctave)
-> XParse (Maybe YesNo) -> XParse KeyOctave
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"cancel") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)

-- | Smart constructor for 'KeyOctave'
mkKeyOctave :: Octave -> PositiveInteger -> KeyOctave
mkKeyOctave :: Octave -> PositiveInteger -> KeyOctave
mkKeyOctave Octave
a PositiveInteger
b = Octave -> PositiveInteger -> Maybe YesNo -> KeyOctave
KeyOctave Octave
a PositiveInteger
b Maybe YesNo
forall a. Maybe a
Nothing

-- | @kind@ /(complex)/
--
-- Kind indicates the type of chord. Degree elements can then add, subtract, or alter from these starting points
--
-- @
-- 
-- The attributes are used to indicate the formatting of the symbol. Since the kind element is the constant in all the harmony-chord groups that can make up a polychord, many formatting attributes are here.
-- 
-- The use-symbols attribute is yes if the kind should be represented when possible with harmony symbols rather than letters and numbers. These symbols include:
-- 
-- 	major: a triangle, like Unicode 25B3
-- 	minor: -, like Unicode 002D
-- 	augmented: +, like Unicode 002B
-- 	diminished: °, like Unicode 00B0
-- 	half-diminished: ø, like Unicode 00F8
-- 
-- For the major-minor kind, only the minor symbol is used when use-symbols is yes. The major symbol is set using the symbol attribute in the degree-value element. The corresponding degree-alter value will usually be 0 in this case.
-- 
-- The text attribute describes how the kind should be spelled in a score. If use-symbols is yes, the value of the text attribute follows the symbol. The stack-degrees attribute is yes if the degree elements should be stacked above each other. The parentheses-degrees attribute is yes if all the degrees should be in parentheses. The bracket-degrees attribute is yes if all the degrees should be in a bracket. If not specified, these values are implementation-specific. The alignment attributes are for the entire harmony-chord group of which this kind element is a part.
-- @
data Kind = 
      Kind {
          Kind -> KindValue
kindKindValue :: KindValue -- ^ text content
        , Kind -> Maybe YesNo
kindUseSymbols :: (Maybe YesNo) -- ^ /use-symbols/ attribute
        , Kind -> Maybe Token
kindText :: (Maybe Token) -- ^ /text/ attribute
        , Kind -> Maybe YesNo
kindStackDegrees :: (Maybe YesNo) -- ^ /stack-degrees/ attribute
        , Kind -> Maybe YesNo
kindParenthesesDegrees :: (Maybe YesNo) -- ^ /parentheses-degrees/ attribute
        , Kind -> Maybe YesNo
kindBracketDegrees :: (Maybe YesNo) -- ^ /bracket-degrees/ attribute
        , Kind -> Maybe Tenths
kindDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Kind -> Maybe Tenths
kindDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Kind -> Maybe Tenths
kindRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Kind -> Maybe Tenths
kindRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Kind -> Maybe CommaSeparatedText
kindFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Kind -> Maybe FontStyle
kindFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Kind -> Maybe FontSize
kindFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Kind -> Maybe FontWeight
kindFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Kind -> Maybe Color
kindColor :: (Maybe Color) -- ^ /color/ attribute
        , Kind -> Maybe LeftCenterRight
kindHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Kind -> Maybe Valign
kindValign :: (Maybe Valign) -- ^ /valign/ attribute
       }
    deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c== :: Kind -> Kind -> Bool
Eq,Typeable,(forall x. Kind -> Rep Kind x)
-> (forall x. Rep Kind x -> Kind) -> Generic Kind
forall x. Rep Kind x -> Kind
forall x. Kind -> Rep Kind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Kind x -> Kind
$cfrom :: forall x. Kind -> Rep Kind x
Generic,Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Kind] -> ShowS
$cshowList :: [Kind] -> ShowS
show :: Kind -> String
$cshow :: Kind -> String
showsPrec :: Int -> Kind -> ShowS
$cshowsPrec :: Int -> Kind -> ShowS
Show)
instance EmitXml Kind where
    emitXml :: Kind -> XmlRep
emitXml (Kind KindValue
a Maybe YesNo
b Maybe Token
c Maybe YesNo
d Maybe YesNo
e Maybe YesNo
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe CommaSeparatedText
k Maybe FontStyle
l Maybe FontSize
m Maybe FontWeight
n Maybe Color
o Maybe LeftCenterRight
p Maybe Valign
q) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (KindValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml KindValue
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"use-symbols" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"stack-degrees" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses-degrees" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket-degrees" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
q])
        []
parseKind :: P.XParse Kind
parseKind :: XParse Kind
parseKind = 
      KindValue
-> Maybe YesNo
-> Maybe Token
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Kind
Kind
        (KindValue
 -> Maybe YesNo
 -> Maybe Token
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Kind)
-> XParse KindValue
-> XParse
     (Maybe YesNo
      -> Maybe Token
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse KindValue) -> XParse KindValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse KindValue
parseKindValue)
        XParse
  (Maybe YesNo
   -> Maybe Token
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Token
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"use-symbols") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Token
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe Token)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"stack-degrees") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses-degrees") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket-degrees") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Kind)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe LeftCenterRight -> Maybe Valign -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe LeftCenterRight -> Maybe Valign -> Kind)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color -> Maybe LeftCenterRight -> Maybe Valign -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color -> Maybe LeftCenterRight -> Maybe Valign -> Kind)
-> XParse (Maybe Color)
-> XParse (Maybe LeftCenterRight -> Maybe Valign -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> Maybe Valign -> Kind)
-> XParse (Maybe LeftCenterRight) -> XParse (Maybe Valign -> Kind)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Kind)
-> XParse (Maybe Valign) -> XParse Kind
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)

-- | Smart constructor for 'Kind'
mkKind :: KindValue -> Kind
mkKind :: KindValue -> Kind
mkKind KindValue
a = KindValue
-> Maybe YesNo
-> Maybe Token
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Kind
Kind KindValue
a Maybe YesNo
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing

-- | @level@ /(complex)/
--
-- The level type is used to specify editorial information for different MusicXML elements. If the reference attribute for the level element is yes, this indicates editorial information that is for display only and should not affect playback. For instance, a modern edition of older music may set reference="yes" on the attributes containing the music's original clef, key, and time signature. It is no by default.
data Level = 
      Level {
          Level -> String
levelString :: String -- ^ text content
        , Level -> Maybe YesNo
levelReference :: (Maybe YesNo) -- ^ /reference/ attribute
        , Level -> Maybe YesNo
levelParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , Level -> Maybe YesNo
levelBracket :: (Maybe YesNo) -- ^ /bracket/ attribute
        , Level -> Maybe SymbolSize
levelSize :: (Maybe SymbolSize) -- ^ /size/ attribute
       }
    deriving (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq,Typeable,(forall x. Level -> Rep Level x)
-> (forall x. Rep Level x -> Level) -> Generic Level
forall x. Rep Level x -> Level
forall x. Level -> Rep Level x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Level x -> Level
$cfrom :: forall x. Level -> Rep Level x
Generic,Int -> Level -> ShowS
[Level] -> ShowS
Level -> String
(Int -> Level -> ShowS)
-> (Level -> String) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> Level -> ShowS
Show)
instance EmitXml Level where
    emitXml :: Level -> XmlRep
emitXml (Level String
a Maybe YesNo
b Maybe YesNo
c Maybe YesNo
d Maybe SymbolSize
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"reference" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SymbolSize -> XmlRep) -> Maybe SymbolSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SymbolSize -> XmlRep) -> SymbolSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SymbolSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SymbolSize
e])
        []
parseLevel :: P.XParse Level
parseLevel :: XParse Level
parseLevel = 
      String
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Level
Level
        (String
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe SymbolSize
 -> Level)
-> XParse String
-> XParse
     (Maybe YesNo
      -> Maybe YesNo -> Maybe YesNo -> Maybe SymbolSize -> Level)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe YesNo
   -> Maybe YesNo -> Maybe YesNo -> Maybe SymbolSize -> Level)
-> XParse (Maybe YesNo)
-> XParse (Maybe YesNo -> Maybe YesNo -> Maybe SymbolSize -> Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"reference") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe YesNo -> Maybe YesNo -> Maybe SymbolSize -> Level)
-> XParse (Maybe YesNo)
-> XParse (Maybe YesNo -> Maybe SymbolSize -> Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe YesNo -> Maybe SymbolSize -> Level)
-> XParse (Maybe YesNo) -> XParse (Maybe SymbolSize -> Level)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe SymbolSize -> Level)
-> XParse (Maybe SymbolSize) -> XParse Level
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SymbolSize -> XParse (Maybe SymbolSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String -> (String -> XParse SymbolSize) -> XParse SymbolSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SymbolSize
parseSymbolSize)

-- | Smart constructor for 'Level'
mkLevel :: String -> Level
mkLevel :: String -> Level
mkLevel String
a = String
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe SymbolSize
-> Level
Level String
a Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe SymbolSize
forall a. Maybe a
Nothing

-- | @line-width@ /(complex)/
--
-- The line-width type indicates the width of a line type in tenths. The type attribute defines what type of line is being defined. Values include beam, bracket, dashes, enclosure, ending, extend, heavy barline, leger, light barline, octave shift, pedal, slur middle, slur tip, staff, stem, tie middle, tie tip, tuplet bracket, and wedge. The text content is expressed in tenths.
data LineWidth = 
      LineWidth {
          LineWidth -> Tenths
lineWidthTenths :: Tenths -- ^ text content
        , LineWidth -> LineWidthType
cmplineWidthType :: LineWidthType -- ^ /type/ attribute
       }
    deriving (LineWidth -> LineWidth -> Bool
(LineWidth -> LineWidth -> Bool)
-> (LineWidth -> LineWidth -> Bool) -> Eq LineWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineWidth -> LineWidth -> Bool
$c/= :: LineWidth -> LineWidth -> Bool
== :: LineWidth -> LineWidth -> Bool
$c== :: LineWidth -> LineWidth -> Bool
Eq,Typeable,(forall x. LineWidth -> Rep LineWidth x)
-> (forall x. Rep LineWidth x -> LineWidth) -> Generic LineWidth
forall x. Rep LineWidth x -> LineWidth
forall x. LineWidth -> Rep LineWidth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineWidth x -> LineWidth
$cfrom :: forall x. LineWidth -> Rep LineWidth x
Generic,Int -> LineWidth -> ShowS
[LineWidth] -> ShowS
LineWidth -> String
(Int -> LineWidth -> ShowS)
-> (LineWidth -> String)
-> ([LineWidth] -> ShowS)
-> Show LineWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineWidth] -> ShowS
$cshowList :: [LineWidth] -> ShowS
show :: LineWidth -> String
$cshow :: LineWidth -> String
showsPrec :: Int -> LineWidth -> ShowS
$cshowsPrec :: Int -> LineWidth -> ShowS
Show)
instance EmitXml LineWidth where
    emitXml :: LineWidth -> XmlRep
emitXml (LineWidth Tenths
a LineWidthType
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (LineWidthType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml LineWidthType
b)])
        []
parseLineWidth :: P.XParse LineWidth
parseLineWidth :: XParse LineWidth
parseLineWidth = 
      Tenths -> LineWidthType -> LineWidth
LineWidth
        (Tenths -> LineWidthType -> LineWidth)
-> XParse Tenths -> XParse (LineWidthType -> LineWidth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (LineWidthType -> LineWidth)
-> XParse LineWidthType -> XParse LineWidth
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse LineWidthType) -> XParse LineWidthType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineWidthType
parseLineWidthType)

-- | Smart constructor for 'LineWidth'
mkLineWidth :: Tenths -> LineWidthType -> LineWidth
mkLineWidth :: Tenths -> LineWidthType -> LineWidth
mkLineWidth Tenths
a LineWidthType
b = Tenths -> LineWidthType -> LineWidth
LineWidth Tenths
a LineWidthType
b

-- | @link@ /(complex)/
--
-- The link type serves as an outgoing simple XLink. It is also used to connect a MusicXML score with a MusicXML opus. If a relative link is used within a document that is part of a compressed MusicXML file, the link is relative to the  root folder of the zip file.
data Link = 
      Link {
          Link -> Maybe Token
linkName :: (Maybe Token) -- ^ /name/ attribute
        , Link -> String
linkHref :: String -- ^ /xlink:href/ attribute
        , Link -> Maybe Type
linkType :: (Maybe Type) -- ^ /xlink:type/ attribute
        , Link -> Maybe Token
linkRole :: (Maybe Token) -- ^ /xlink:role/ attribute
        , Link -> Maybe Token
linkTitle :: (Maybe Token) -- ^ /xlink:title/ attribute
        , Link -> Maybe SmpShow
linkShow :: (Maybe SmpShow) -- ^ /xlink:show/ attribute
        , Link -> Maybe Actuate
linkActuate :: (Maybe Actuate) -- ^ /xlink:actuate/ attribute
        , Link -> Maybe NMTOKEN
linkElement :: (Maybe NMTOKEN) -- ^ /element/ attribute
        , Link -> Maybe PositiveInteger
linkPosition :: (Maybe PositiveInteger) -- ^ /position/ attribute
        , Link -> Maybe Tenths
linkDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Link -> Maybe Tenths
linkDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Link -> Maybe Tenths
linkRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Link -> Maybe Tenths
linkRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
       }
    deriving (Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq,Typeable,(forall x. Link -> Rep Link x)
-> (forall x. Rep Link x -> Link) -> Generic Link
forall x. Rep Link x -> Link
forall x. Link -> Rep Link x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Link x -> Link
$cfrom :: forall x. Link -> Rep Link x
Generic,Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show)
instance EmitXml Link where
    emitXml :: Link -> XmlRep
emitXml (Link Maybe Token
a String
b Maybe Type
c Maybe Token
d Maybe Token
e Maybe SmpShow
f Maybe Actuate
g Maybe NMTOKEN
h Maybe PositiveInteger
i Maybe Tenths
j Maybe Tenths
k Maybe Tenths
l Maybe Tenths
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink")) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Type -> XmlRep) -> Maybe Type -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Type -> XmlRep) -> Type -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Type -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Type
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"role" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"title" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SmpShow -> XmlRep) -> Maybe SmpShow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (SmpShow -> XmlRep) -> SmpShow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmpShow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmpShow
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Actuate -> XmlRep) -> Maybe Actuate -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"actuate" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Actuate -> XmlRep) -> Actuate -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Actuate -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Actuate
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"element" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"position" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
m])
        []
parseLink :: P.XParse Link
parseLink :: XParse Link
parseLink = 
      Maybe Token
-> String
-> Maybe Type
-> Maybe Token
-> Maybe Token
-> Maybe SmpShow
-> Maybe Actuate
-> Maybe NMTOKEN
-> Maybe PositiveInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Link
Link
        (Maybe Token
 -> String
 -> Maybe Type
 -> Maybe Token
 -> Maybe Token
 -> Maybe SmpShow
 -> Maybe Actuate
 -> Maybe NMTOKEN
 -> Maybe PositiveInteger
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Link)
-> XParse (Maybe Token)
-> XParse
     (String
      -> Maybe Type
      -> Maybe Token
      -> Maybe Token
      -> Maybe SmpShow
      -> Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (String
   -> Maybe Type
   -> Maybe Token
   -> Maybe Token
   -> Maybe SmpShow
   -> Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse String
-> XParse
     (Maybe Type
      -> Maybe Token
      -> Maybe Token
      -> Maybe SmpShow
      -> Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:href") XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Type
   -> Maybe Token
   -> Maybe Token
   -> Maybe SmpShow
   -> Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe Type)
-> XParse
     (Maybe Token
      -> Maybe Token
      -> Maybe SmpShow
      -> Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Type -> XParse (Maybe Type)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:type") XParse String -> (String -> XParse Type) -> XParse Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Type
parseType)
        XParse
  (Maybe Token
   -> Maybe Token
   -> Maybe SmpShow
   -> Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe Token)
-> XParse
     (Maybe Token
      -> Maybe SmpShow
      -> Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:role") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Token
   -> Maybe SmpShow
   -> Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe Token)
-> XParse
     (Maybe SmpShow
      -> Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:title") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe SmpShow
   -> Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe SmpShow)
-> XParse
     (Maybe Actuate
      -> Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmpShow -> XParse (Maybe SmpShow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:show") XParse String -> (String -> XParse SmpShow) -> XParse SmpShow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmpShow
parseSmpShow)
        XParse
  (Maybe Actuate
   -> Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe Actuate)
-> XParse
     (Maybe NMTOKEN
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Actuate -> XParse (Maybe Actuate)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:actuate") XParse String -> (String -> XParse Actuate) -> XParse Actuate
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Actuate
parseActuate)
        XParse
  (Maybe NMTOKEN
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe NMTOKEN)
-> XParse
     (Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"element") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse
  (Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Link)
-> XParse (Maybe PositiveInteger)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Tenths -> Maybe Tenths -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"position") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Tenths -> Maybe Tenths -> Link)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Tenths -> Maybe Tenths -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Maybe Tenths -> Link)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Tenths -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Link)
-> XParse (Maybe Tenths) -> XParse (Maybe Tenths -> Link)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Link)
-> XParse (Maybe Tenths) -> XParse Link
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)

-- | Smart constructor for 'Link'
mkLink :: String -> Link
mkLink :: String -> Link
mkLink String
b = Maybe Token
-> String
-> Maybe Type
-> Maybe Token
-> Maybe Token
-> Maybe SmpShow
-> Maybe Actuate
-> Maybe NMTOKEN
-> Maybe PositiveInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Link
Link Maybe Token
forall a. Maybe a
Nothing String
b Maybe Type
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe SmpShow
forall a. Maybe a
Nothing Maybe Actuate
forall a. Maybe a
Nothing Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe PositiveInteger
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing

-- | @lyric@ /(complex)/
--
-- The lyric type represents text underlays for lyrics, based on Humdrum with support for other formats. Two text elements that are not separated by an elision element are part of the same syllable, but may have different text formatting. The MusicXML XSD is more strict than the DTD in enforcing this by disallowing a second syllabic element unless preceded by an elision element. The lyric number indicates multiple lines, though a name can be used as well (as in Finale's verse / chorus / section specification).
-- 
-- Justification is center by default; placement is below by default. The print-object attribute can override a note's print-lyric attribute in cases where only some lyrics on a note are printed, as when lyrics for later verses are printed in a block of text rather than with each note. The time-only attribute precisely specifies which lyrics are to be sung which time through a repeated section.
data Lyric = 
      Lyric {
          Lyric -> Maybe NMTOKEN
lyricNumber :: (Maybe NMTOKEN) -- ^ /number/ attribute
        , Lyric -> Maybe Token
lyricName :: (Maybe Token) -- ^ /name/ attribute
        , Lyric -> Maybe TimeOnly
lyricTimeOnly :: (Maybe TimeOnly) -- ^ /time-only/ attribute
        , Lyric -> Maybe LeftCenterRight
lyricJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , Lyric -> Maybe Tenths
lyricDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Lyric -> Maybe Tenths
lyricDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Lyric -> Maybe Tenths
lyricRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Lyric -> Maybe Tenths
lyricRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Lyric -> Maybe AboveBelow
lyricPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Lyric -> Maybe Color
lyricColor :: (Maybe Color) -- ^ /color/ attribute
        , Lyric -> Maybe YesNo
lyricPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Lyric -> Maybe ID
lyricId :: (Maybe ID) -- ^ /id/ attribute
        , Lyric -> ChxLyric
lyricLyric :: ChxLyric
        , Lyric -> Maybe Empty
lyricEndLine :: (Maybe Empty) -- ^ /end-line/ child element
        , Lyric -> Maybe Empty
lyricEndParagraph :: (Maybe Empty) -- ^ /end-paragraph/ child element
        , Lyric -> Editorial
lyricEditorial :: Editorial
       }
    deriving (Lyric -> Lyric -> Bool
(Lyric -> Lyric -> Bool) -> (Lyric -> Lyric -> Bool) -> Eq Lyric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lyric -> Lyric -> Bool
$c/= :: Lyric -> Lyric -> Bool
== :: Lyric -> Lyric -> Bool
$c== :: Lyric -> Lyric -> Bool
Eq,Typeable,(forall x. Lyric -> Rep Lyric x)
-> (forall x. Rep Lyric x -> Lyric) -> Generic Lyric
forall x. Rep Lyric x -> Lyric
forall x. Lyric -> Rep Lyric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Lyric x -> Lyric
$cfrom :: forall x. Lyric -> Rep Lyric x
Generic,Int -> Lyric -> ShowS
[Lyric] -> ShowS
Lyric -> String
(Int -> Lyric -> ShowS)
-> (Lyric -> String) -> ([Lyric] -> ShowS) -> Show Lyric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lyric] -> ShowS
$cshowList :: [Lyric] -> ShowS
show :: Lyric -> String
$cshow :: Lyric -> String
showsPrec :: Int -> Lyric -> ShowS
$cshowsPrec :: Int -> Lyric -> ShowS
Show)
instance EmitXml Lyric where
    emitXml :: Lyric -> XmlRep
emitXml (Lyric Maybe NMTOKEN
a Maybe Token
b Maybe TimeOnly
c Maybe LeftCenterRight
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe AboveBelow
i Maybe Color
j Maybe YesNo
k Maybe ID
l ChxLyric
m Maybe Empty
n Maybe Empty
o Editorial
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TimeOnly -> XmlRep) -> Maybe TimeOnly -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"time-only" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TimeOnly -> XmlRep) -> TimeOnly -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeOnly -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeOnly
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        ([ChxLyric -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxLyric
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"end-line" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"end-paragraph" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
p])
parseLyric :: P.XParse Lyric
parseLyric :: XParse Lyric
parseLyric = 
      Maybe NMTOKEN
-> Maybe Token
-> Maybe TimeOnly
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ChxLyric
-> Maybe Empty
-> Maybe Empty
-> Editorial
-> Lyric
Lyric
        (Maybe NMTOKEN
 -> Maybe Token
 -> Maybe TimeOnly
 -> Maybe LeftCenterRight
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe ID
 -> ChxLyric
 -> Maybe Empty
 -> Maybe Empty
 -> Editorial
 -> Lyric)
-> XParse (Maybe NMTOKEN)
-> XParse
     (Maybe Token
      -> Maybe TimeOnly
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse
  (Maybe Token
   -> Maybe TimeOnly
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Token)
-> XParse
     (Maybe TimeOnly
      -> Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe TimeOnly
   -> Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe TimeOnly)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeOnly -> XParse (Maybe TimeOnly)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"time-only") XParse String -> (String -> XParse TimeOnly) -> XParse TimeOnly
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeOnly
parseTimeOnly)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe ID
      -> ChxLyric
      -> Maybe Empty
      -> Maybe Empty
      -> Editorial
      -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe ID
   -> ChxLyric
   -> Maybe Empty
   -> Maybe Empty
   -> Editorial
   -> Lyric)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ID
      -> ChxLyric -> Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ID
   -> ChxLyric -> Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
-> XParse (Maybe ID)
-> XParse
     (ChxLyric -> Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (ChxLyric -> Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
-> XParse ChxLyric
-> XParse (Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxLyric
parseChxLyric
        XParse (Maybe Empty -> Maybe Empty -> Editorial -> Lyric)
-> XParse (Maybe Empty)
-> XParse (Maybe Empty -> Editorial -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"end-line") (XParse Empty
parseEmpty))
        XParse (Maybe Empty -> Editorial -> Lyric)
-> XParse (Maybe Empty) -> XParse (Editorial -> Lyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"end-paragraph") (XParse Empty
parseEmpty))
        XParse (Editorial -> Lyric) -> XParse Editorial -> XParse Lyric
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial

-- | Smart constructor for 'Lyric'
mkLyric :: ChxLyric -> Editorial -> Lyric
mkLyric :: ChxLyric -> Editorial -> Lyric
mkLyric ChxLyric
m Editorial
p = Maybe NMTOKEN
-> Maybe Token
-> Maybe TimeOnly
-> Maybe LeftCenterRight
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe YesNo
-> Maybe ID
-> ChxLyric
-> Maybe Empty
-> Maybe Empty
-> Editorial
-> Lyric
Lyric Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe TimeOnly
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxLyric
m Maybe Empty
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing Editorial
p

-- | @lyric-font@ /(complex)/
--
-- The lyric-font type specifies the default font for a particular name and number of lyric.
data LyricFont = 
      LyricFont {
          LyricFont -> Maybe NMTOKEN
lyricFontNumber :: (Maybe NMTOKEN) -- ^ /number/ attribute
        , LyricFont -> Maybe Token
lyricFontName :: (Maybe Token) -- ^ /name/ attribute
        , LyricFont -> Maybe CommaSeparatedText
lyricFontFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , LyricFont -> Maybe FontStyle
lyricFontFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , LyricFont -> Maybe FontSize
lyricFontFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , LyricFont -> Maybe FontWeight
lyricFontFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
       }
    deriving (LyricFont -> LyricFont -> Bool
(LyricFont -> LyricFont -> Bool)
-> (LyricFont -> LyricFont -> Bool) -> Eq LyricFont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LyricFont -> LyricFont -> Bool
$c/= :: LyricFont -> LyricFont -> Bool
== :: LyricFont -> LyricFont -> Bool
$c== :: LyricFont -> LyricFont -> Bool
Eq,Typeable,(forall x. LyricFont -> Rep LyricFont x)
-> (forall x. Rep LyricFont x -> LyricFont) -> Generic LyricFont
forall x. Rep LyricFont x -> LyricFont
forall x. LyricFont -> Rep LyricFont x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LyricFont x -> LyricFont
$cfrom :: forall x. LyricFont -> Rep LyricFont x
Generic,Int -> LyricFont -> ShowS
[LyricFont] -> ShowS
LyricFont -> String
(Int -> LyricFont -> ShowS)
-> (LyricFont -> String)
-> ([LyricFont] -> ShowS)
-> Show LyricFont
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LyricFont] -> ShowS
$cshowList :: [LyricFont] -> ShowS
show :: LyricFont -> String
$cshow :: LyricFont -> String
showsPrec :: Int -> LyricFont -> ShowS
$cshowsPrec :: Int -> LyricFont -> ShowS
Show)
instance EmitXml LyricFont where
    emitXml :: LyricFont -> XmlRep
emitXml (LyricFont Maybe NMTOKEN
a Maybe Token
b Maybe CommaSeparatedText
c Maybe FontStyle
d Maybe FontSize
e Maybe FontWeight
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
f])
        []
parseLyricFont :: P.XParse LyricFont
parseLyricFont :: XParse LyricFont
parseLyricFont = 
      Maybe NMTOKEN
-> Maybe Token
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> LyricFont
LyricFont
        (Maybe NMTOKEN
 -> Maybe Token
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> LyricFont)
-> XParse (Maybe NMTOKEN)
-> XParse
     (Maybe Token
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> LyricFont)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse
  (Maybe Token
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> LyricFont)
-> XParse (Maybe Token)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> LyricFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> LyricFont)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> LyricFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> LyricFont)
-> XParse (Maybe FontStyle)
-> XParse (Maybe FontSize -> Maybe FontWeight -> LyricFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse (Maybe FontSize -> Maybe FontWeight -> LyricFont)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> LyricFont)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> LyricFont)
-> XParse (Maybe FontWeight) -> XParse LyricFont
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)

-- | Smart constructor for 'LyricFont'
mkLyricFont :: LyricFont
mkLyricFont :: LyricFont
mkLyricFont = Maybe NMTOKEN
-> Maybe Token
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> LyricFont
LyricFont Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing

-- | @lyric-language@ /(complex)/
--
-- The lyric-language type specifies the default language for a particular name and number of lyric.
data LyricLanguage = 
      LyricLanguage {
          LyricLanguage -> Maybe NMTOKEN
lyricLanguageNumber :: (Maybe NMTOKEN) -- ^ /number/ attribute
        , LyricLanguage -> Maybe Token
lyricLanguageName :: (Maybe Token) -- ^ /name/ attribute
        , LyricLanguage -> Lang
lyricLanguageLang :: Lang -- ^ /xml:lang/ attribute
       }
    deriving (LyricLanguage -> LyricLanguage -> Bool
(LyricLanguage -> LyricLanguage -> Bool)
-> (LyricLanguage -> LyricLanguage -> Bool) -> Eq LyricLanguage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LyricLanguage -> LyricLanguage -> Bool
$c/= :: LyricLanguage -> LyricLanguage -> Bool
== :: LyricLanguage -> LyricLanguage -> Bool
$c== :: LyricLanguage -> LyricLanguage -> Bool
Eq,Typeable,(forall x. LyricLanguage -> Rep LyricLanguage x)
-> (forall x. Rep LyricLanguage x -> LyricLanguage)
-> Generic LyricLanguage
forall x. Rep LyricLanguage x -> LyricLanguage
forall x. LyricLanguage -> Rep LyricLanguage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LyricLanguage x -> LyricLanguage
$cfrom :: forall x. LyricLanguage -> Rep LyricLanguage x
Generic,Int -> LyricLanguage -> ShowS
[LyricLanguage] -> ShowS
LyricLanguage -> String
(Int -> LyricLanguage -> ShowS)
-> (LyricLanguage -> String)
-> ([LyricLanguage] -> ShowS)
-> Show LyricLanguage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LyricLanguage] -> ShowS
$cshowList :: [LyricLanguage] -> ShowS
show :: LyricLanguage -> String
$cshow :: LyricLanguage -> String
showsPrec :: Int -> LyricLanguage -> ShowS
$cshowsPrec :: Int -> LyricLanguage -> ShowS
Show)
instance EmitXml LyricLanguage where
    emitXml :: LyricLanguage -> XmlRep
emitXml (LyricLanguage Maybe NMTOKEN
a Maybe Token
b Lang
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml")) (Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Lang
c)])
        []
parseLyricLanguage :: P.XParse LyricLanguage
parseLyricLanguage :: XParse LyricLanguage
parseLyricLanguage = 
      Maybe NMTOKEN -> Maybe Token -> Lang -> LyricLanguage
LyricLanguage
        (Maybe NMTOKEN -> Maybe Token -> Lang -> LyricLanguage)
-> XParse (Maybe NMTOKEN)
-> XParse (Maybe Token -> Lang -> LyricLanguage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse (Maybe Token -> Lang -> LyricLanguage)
-> XParse (Maybe Token) -> XParse (Lang -> LyricLanguage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Lang -> LyricLanguage)
-> XParse Lang -> XParse LyricLanguage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)

-- | Smart constructor for 'LyricLanguage'
mkLyricLanguage :: Lang -> LyricLanguage
mkLyricLanguage :: Lang -> LyricLanguage
mkLyricLanguage Lang
c = Maybe NMTOKEN -> Maybe Token -> Lang -> LyricLanguage
LyricLanguage Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Lang
c

-- | @measure@ /(complex)/
data Measure = 
      Measure {
          Measure -> Token
measureNumber :: Token -- ^ /number/ attribute
        , Measure -> Maybe MeasureText
cmpmeasureText :: (Maybe MeasureText) -- ^ /text/ attribute
        , Measure -> Maybe YesNo
measureImplicit :: (Maybe YesNo) -- ^ /implicit/ attribute
        , Measure -> Maybe YesNo
measureNonControlling :: (Maybe YesNo) -- ^ /non-controlling/ attribute
        , Measure -> Maybe Tenths
measureWidth :: (Maybe Tenths) -- ^ /width/ attribute
        , Measure -> Maybe ID
measureId :: (Maybe ID) -- ^ /id/ attribute
        , Measure -> MusicData
measureMusicData :: MusicData
       }
    deriving (Measure -> Measure -> Bool
(Measure -> Measure -> Bool)
-> (Measure -> Measure -> Bool) -> Eq Measure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Measure -> Measure -> Bool
$c/= :: Measure -> Measure -> Bool
== :: Measure -> Measure -> Bool
$c== :: Measure -> Measure -> Bool
Eq,Typeable,(forall x. Measure -> Rep Measure x)
-> (forall x. Rep Measure x -> Measure) -> Generic Measure
forall x. Rep Measure x -> Measure
forall x. Measure -> Rep Measure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Measure x -> Measure
$cfrom :: forall x. Measure -> Rep Measure x
Generic,Int -> Measure -> ShowS
[Measure] -> ShowS
Measure -> String
(Int -> Measure -> ShowS)
-> (Measure -> String) -> ([Measure] -> ShowS) -> Show Measure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measure] -> ShowS
$cshowList :: [Measure] -> ShowS
show :: Measure -> String
$cshow :: Measure -> String
showsPrec :: Int -> Measure -> ShowS
$cshowsPrec :: Int -> Measure -> ShowS
Show)
instance EmitXml Measure where
    emitXml :: Measure -> XmlRep
emitXml (Measure Token
a Maybe MeasureText
b Maybe YesNo
c Maybe YesNo
d Maybe Tenths
e Maybe ID
f MusicData
g) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (MeasureText -> XmlRep) -> Maybe MeasureText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MeasureText -> XmlRep) -> MeasureText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MeasureText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MeasureText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"implicit" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"non-controlling" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"width" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
f])
        ([MusicData -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MusicData
g])
parseMeasure :: P.XParse Measure
parseMeasure :: XParse Measure
parseMeasure = 
      Token
-> Maybe MeasureText
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe ID
-> MusicData
-> Measure
Measure
        (Token
 -> Maybe MeasureText
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe ID
 -> MusicData
 -> Measure)
-> XParse Token
-> XParse
     (Maybe MeasureText
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe ID
      -> MusicData
      -> Measure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe MeasureText
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe ID
   -> MusicData
   -> Measure)
-> XParse (Maybe MeasureText)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo -> Maybe Tenths -> Maybe ID -> MusicData -> Measure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MeasureText -> XParse (Maybe MeasureText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String
-> (String -> XParse MeasureText) -> XParse MeasureText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse MeasureText
parseMeasureText)
        XParse
  (Maybe YesNo
   -> Maybe YesNo -> Maybe Tenths -> Maybe ID -> MusicData -> Measure)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo -> Maybe Tenths -> Maybe ID -> MusicData -> Measure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"implicit") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo -> Maybe Tenths -> Maybe ID -> MusicData -> Measure)
-> XParse (Maybe YesNo)
-> XParse (Maybe Tenths -> Maybe ID -> MusicData -> Measure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"non-controlling") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe Tenths -> Maybe ID -> MusicData -> Measure)
-> XParse (Maybe Tenths)
-> XParse (Maybe ID -> MusicData -> Measure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"width") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe ID -> MusicData -> Measure)
-> XParse (Maybe ID) -> XParse (MusicData -> Measure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (MusicData -> Measure) -> XParse MusicData -> XParse Measure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MusicData
parseMusicData

-- | Smart constructor for 'Measure'
mkMeasure :: Token -> MusicData -> Measure
mkMeasure :: Token -> MusicData -> Measure
mkMeasure Token
a MusicData
g = Token
-> Maybe MeasureText
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe ID
-> MusicData
-> Measure
Measure Token
a Maybe MeasureText
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing MusicData
g

-- | @measure@ /(complex)/

-- mangled: 1
data CmpMeasure = 
      CmpMeasure {
          CmpMeasure -> Token
cmpmeasureNumber :: Token -- ^ /number/ attribute
        , CmpMeasure -> Maybe MeasureText
cmpmeasureText1 :: (Maybe MeasureText) -- ^ /text/ attribute
        , CmpMeasure -> Maybe YesNo
cmpmeasureImplicit :: (Maybe YesNo) -- ^ /implicit/ attribute
        , CmpMeasure -> Maybe YesNo
cmpmeasureNonControlling :: (Maybe YesNo) -- ^ /non-controlling/ attribute
        , CmpMeasure -> Maybe Tenths
cmpmeasureWidth :: (Maybe Tenths) -- ^ /width/ attribute
        , CmpMeasure -> Maybe ID
cmpmeasureId :: (Maybe ID) -- ^ /id/ attribute
        , CmpMeasure -> [Part]
measurePart :: [Part] -- ^ /part/ child element
       }
    deriving (CmpMeasure -> CmpMeasure -> Bool
(CmpMeasure -> CmpMeasure -> Bool)
-> (CmpMeasure -> CmpMeasure -> Bool) -> Eq CmpMeasure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpMeasure -> CmpMeasure -> Bool
$c/= :: CmpMeasure -> CmpMeasure -> Bool
== :: CmpMeasure -> CmpMeasure -> Bool
$c== :: CmpMeasure -> CmpMeasure -> Bool
Eq,Typeable,(forall x. CmpMeasure -> Rep CmpMeasure x)
-> (forall x. Rep CmpMeasure x -> CmpMeasure) -> Generic CmpMeasure
forall x. Rep CmpMeasure x -> CmpMeasure
forall x. CmpMeasure -> Rep CmpMeasure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpMeasure x -> CmpMeasure
$cfrom :: forall x. CmpMeasure -> Rep CmpMeasure x
Generic,Int -> CmpMeasure -> ShowS
[CmpMeasure] -> ShowS
CmpMeasure -> String
(Int -> CmpMeasure -> ShowS)
-> (CmpMeasure -> String)
-> ([CmpMeasure] -> ShowS)
-> Show CmpMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpMeasure] -> ShowS
$cshowList :: [CmpMeasure] -> ShowS
show :: CmpMeasure -> String
$cshow :: CmpMeasure -> String
showsPrec :: Int -> CmpMeasure -> ShowS
$cshowsPrec :: Int -> CmpMeasure -> ShowS
Show)
instance EmitXml CmpMeasure where
    emitXml :: CmpMeasure -> XmlRep
emitXml (CmpMeasure Token
a Maybe MeasureText
b Maybe YesNo
c Maybe YesNo
d Maybe Tenths
e Maybe ID
f [Part]
g) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (MeasureText -> XmlRep) -> Maybe MeasureText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MeasureText -> XmlRep) -> MeasureText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MeasureText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MeasureText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"implicit" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"non-controlling" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"width" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
f])
        ((Part -> XmlRep) -> [Part] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Part -> XmlRep) -> Part -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Part -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Part]
g)
parseCmpMeasure :: P.XParse CmpMeasure
parseCmpMeasure :: XParse CmpMeasure
parseCmpMeasure = 
      Token
-> Maybe MeasureText
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe ID
-> [Part]
-> CmpMeasure
CmpMeasure
        (Token
 -> Maybe MeasureText
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe ID
 -> [Part]
 -> CmpMeasure)
-> XParse Token
-> XParse
     (Maybe MeasureText
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe ID
      -> [Part]
      -> CmpMeasure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe MeasureText
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe ID
   -> [Part]
   -> CmpMeasure)
-> XParse (Maybe MeasureText)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo -> Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MeasureText -> XParse (Maybe MeasureText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String
-> (String -> XParse MeasureText) -> XParse MeasureText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse MeasureText
parseMeasureText)
        XParse
  (Maybe YesNo
   -> Maybe YesNo -> Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo -> Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"implicit") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo -> Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
-> XParse (Maybe YesNo)
-> XParse (Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"non-controlling") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe Tenths -> Maybe ID -> [Part] -> CmpMeasure)
-> XParse (Maybe Tenths)
-> XParse (Maybe ID -> [Part] -> CmpMeasure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"width") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe ID -> [Part] -> CmpMeasure)
-> XParse (Maybe ID) -> XParse ([Part] -> CmpMeasure)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([Part] -> CmpMeasure) -> XParse [Part] -> XParse CmpMeasure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Part -> XParse [Part]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Part -> XParse Part
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part") (XParse Part
parsePart))

-- | Smart constructor for 'CmpMeasure'
mkCmpMeasure :: Token -> CmpMeasure
mkCmpMeasure :: Token -> CmpMeasure
mkCmpMeasure Token
a = Token
-> Maybe MeasureText
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe ID
-> [Part]
-> CmpMeasure
CmpMeasure Token
a Maybe MeasureText
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing []

-- | @measure-layout@ /(complex)/
--
-- The measure-layout type includes the horizontal distance from the previous measure.
data MeasureLayout = 
      MeasureLayout {
          MeasureLayout -> Maybe Tenths
measureLayoutMeasureDistance :: (Maybe Tenths) -- ^ /measure-distance/ child element
       }
    deriving (MeasureLayout -> MeasureLayout -> Bool
(MeasureLayout -> MeasureLayout -> Bool)
-> (MeasureLayout -> MeasureLayout -> Bool) -> Eq MeasureLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureLayout -> MeasureLayout -> Bool
$c/= :: MeasureLayout -> MeasureLayout -> Bool
== :: MeasureLayout -> MeasureLayout -> Bool
$c== :: MeasureLayout -> MeasureLayout -> Bool
Eq,Typeable,(forall x. MeasureLayout -> Rep MeasureLayout x)
-> (forall x. Rep MeasureLayout x -> MeasureLayout)
-> Generic MeasureLayout
forall x. Rep MeasureLayout x -> MeasureLayout
forall x. MeasureLayout -> Rep MeasureLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureLayout x -> MeasureLayout
$cfrom :: forall x. MeasureLayout -> Rep MeasureLayout x
Generic,Int -> MeasureLayout -> ShowS
[MeasureLayout] -> ShowS
MeasureLayout -> String
(Int -> MeasureLayout -> ShowS)
-> (MeasureLayout -> String)
-> ([MeasureLayout] -> ShowS)
-> Show MeasureLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasureLayout] -> ShowS
$cshowList :: [MeasureLayout] -> ShowS
show :: MeasureLayout -> String
$cshow :: MeasureLayout -> String
showsPrec :: Int -> MeasureLayout -> ShowS
$cshowsPrec :: Int -> MeasureLayout -> ShowS
Show)
instance EmitXml MeasureLayout where
    emitXml :: MeasureLayout -> XmlRep
emitXml (MeasureLayout Maybe Tenths
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure-distance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a])
parseMeasureLayout :: P.XParse MeasureLayout
parseMeasureLayout :: XParse MeasureLayout
parseMeasureLayout = 
      Maybe Tenths -> MeasureLayout
MeasureLayout
        (Maybe Tenths -> MeasureLayout)
-> XParse (Maybe Tenths) -> XParse MeasureLayout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure-distance") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'MeasureLayout'
mkMeasureLayout :: MeasureLayout
mkMeasureLayout :: MeasureLayout
mkMeasureLayout = Maybe Tenths -> MeasureLayout
MeasureLayout Maybe Tenths
forall a. Maybe a
Nothing

-- | @measure-numbering@ /(complex)/
--
-- The measure-numbering type describes how frequently measure numbers are displayed on this part. The number attribute from the measure element is used for printing. Measures with an implicit attribute set to "yes" never display a measure number, regardless of the measure-numbering setting.
data MeasureNumbering = 
      MeasureNumbering {
          MeasureNumbering -> MeasureNumberingValue
measureNumberingMeasureNumberingValue :: MeasureNumberingValue -- ^ text content
        , MeasureNumbering -> Maybe Tenths
measureNumberingDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , MeasureNumbering -> Maybe Tenths
measureNumberingDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , MeasureNumbering -> Maybe Tenths
measureNumberingRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , MeasureNumbering -> Maybe Tenths
measureNumberingRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , MeasureNumbering -> Maybe CommaSeparatedText
measureNumberingFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , MeasureNumbering -> Maybe FontStyle
measureNumberingFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , MeasureNumbering -> Maybe FontSize
measureNumberingFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , MeasureNumbering -> Maybe FontWeight
measureNumberingFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , MeasureNumbering -> Maybe Color
measureNumberingColor :: (Maybe Color) -- ^ /color/ attribute
        , MeasureNumbering -> Maybe LeftCenterRight
measureNumberingHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , MeasureNumbering -> Maybe Valign
measureNumberingValign :: (Maybe Valign) -- ^ /valign/ attribute
       }
    deriving (MeasureNumbering -> MeasureNumbering -> Bool
(MeasureNumbering -> MeasureNumbering -> Bool)
-> (MeasureNumbering -> MeasureNumbering -> Bool)
-> Eq MeasureNumbering
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureNumbering -> MeasureNumbering -> Bool
$c/= :: MeasureNumbering -> MeasureNumbering -> Bool
== :: MeasureNumbering -> MeasureNumbering -> Bool
$c== :: MeasureNumbering -> MeasureNumbering -> Bool
Eq,Typeable,(forall x. MeasureNumbering -> Rep MeasureNumbering x)
-> (forall x. Rep MeasureNumbering x -> MeasureNumbering)
-> Generic MeasureNumbering
forall x. Rep MeasureNumbering x -> MeasureNumbering
forall x. MeasureNumbering -> Rep MeasureNumbering x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureNumbering x -> MeasureNumbering
$cfrom :: forall x. MeasureNumbering -> Rep MeasureNumbering x
Generic,Int -> MeasureNumbering -> ShowS
[MeasureNumbering] -> ShowS
MeasureNumbering -> String
(Int -> MeasureNumbering -> ShowS)
-> (MeasureNumbering -> String)
-> ([MeasureNumbering] -> ShowS)
-> Show MeasureNumbering
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasureNumbering] -> ShowS
$cshowList :: [MeasureNumbering] -> ShowS
show :: MeasureNumbering -> String
$cshow :: MeasureNumbering -> String
showsPrec :: Int -> MeasureNumbering -> ShowS
$cshowsPrec :: Int -> MeasureNumbering -> ShowS
Show)
instance EmitXml MeasureNumbering where
    emitXml :: MeasureNumbering -> XmlRep
emitXml (MeasureNumbering MeasureNumberingValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (MeasureNumberingValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MeasureNumberingValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l])
        []
parseMeasureNumbering :: P.XParse MeasureNumbering
parseMeasureNumbering :: XParse MeasureNumbering
parseMeasureNumbering = 
      MeasureNumberingValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> MeasureNumbering
MeasureNumbering
        (MeasureNumberingValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> MeasureNumbering)
-> XParse MeasureNumberingValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse MeasureNumberingValue)
-> XParse MeasureNumberingValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse MeasureNumberingValue
parseMeasureNumberingValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> MeasureNumbering)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight -> Maybe Valign -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight -> Maybe Valign -> MeasureNumbering)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> Maybe Valign -> MeasureNumbering)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> MeasureNumbering)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> MeasureNumbering)
-> XParse (Maybe Valign) -> XParse MeasureNumbering
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)

-- | Smart constructor for 'MeasureNumbering'
mkMeasureNumbering :: MeasureNumberingValue -> MeasureNumbering
mkMeasureNumbering :: MeasureNumberingValue -> MeasureNumbering
mkMeasureNumbering MeasureNumberingValue
a = MeasureNumberingValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> MeasureNumbering
MeasureNumbering MeasureNumberingValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing

-- | @measure-repeat@ /(complex)/
--
-- The measure-repeat type is used for both single and multiple measure repeats. The text of the element indicates the number of measures to be repeated in a single pattern. The slashes attribute specifies the number of slashes to use in the repeat sign. It is 1 if not specified. Both the start and the stop of the measure-repeat must be specified. The text of the element is ignored when the type is stop.
-- 
-- The measure-repeat element specifies a notation style for repetitions. The actual music being repeated needs to be repeated within the MusicXML file. This element specifies the notation that indicates the repeat.
data MeasureRepeat = 
      MeasureRepeat {
          MeasureRepeat -> PositiveIntegerOrEmpty
measureRepeatPositiveIntegerOrEmpty :: PositiveIntegerOrEmpty -- ^ text content
        , MeasureRepeat -> StartStop
measureRepeatType :: StartStop -- ^ /type/ attribute
        , MeasureRepeat -> Maybe PositiveInteger
measureRepeatSlashes :: (Maybe PositiveInteger) -- ^ /slashes/ attribute
       }
    deriving (MeasureRepeat -> MeasureRepeat -> Bool
(MeasureRepeat -> MeasureRepeat -> Bool)
-> (MeasureRepeat -> MeasureRepeat -> Bool) -> Eq MeasureRepeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureRepeat -> MeasureRepeat -> Bool
$c/= :: MeasureRepeat -> MeasureRepeat -> Bool
== :: MeasureRepeat -> MeasureRepeat -> Bool
$c== :: MeasureRepeat -> MeasureRepeat -> Bool
Eq,Typeable,(forall x. MeasureRepeat -> Rep MeasureRepeat x)
-> (forall x. Rep MeasureRepeat x -> MeasureRepeat)
-> Generic MeasureRepeat
forall x. Rep MeasureRepeat x -> MeasureRepeat
forall x. MeasureRepeat -> Rep MeasureRepeat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureRepeat x -> MeasureRepeat
$cfrom :: forall x. MeasureRepeat -> Rep MeasureRepeat x
Generic,Int -> MeasureRepeat -> ShowS
[MeasureRepeat] -> ShowS
MeasureRepeat -> String
(Int -> MeasureRepeat -> ShowS)
-> (MeasureRepeat -> String)
-> ([MeasureRepeat] -> ShowS)
-> Show MeasureRepeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasureRepeat] -> ShowS
$cshowList :: [MeasureRepeat] -> ShowS
show :: MeasureRepeat -> String
$cshow :: MeasureRepeat -> String
showsPrec :: Int -> MeasureRepeat -> ShowS
$cshowsPrec :: Int -> MeasureRepeat -> ShowS
Show)
instance EmitXml MeasureRepeat where
    emitXml :: MeasureRepeat -> XmlRep
emitXml (MeasureRepeat PositiveIntegerOrEmpty
a StartStop
b Maybe PositiveInteger
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (PositiveIntegerOrEmpty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveIntegerOrEmpty
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"slashes" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
c])
        []
parseMeasureRepeat :: P.XParse MeasureRepeat
parseMeasureRepeat :: XParse MeasureRepeat
parseMeasureRepeat = 
      PositiveIntegerOrEmpty
-> StartStop -> Maybe PositiveInteger -> MeasureRepeat
MeasureRepeat
        (PositiveIntegerOrEmpty
 -> StartStop -> Maybe PositiveInteger -> MeasureRepeat)
-> XParse PositiveIntegerOrEmpty
-> XParse (StartStop -> Maybe PositiveInteger -> MeasureRepeat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse PositiveIntegerOrEmpty)
-> XParse PositiveIntegerOrEmpty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveIntegerOrEmpty
parsePositiveIntegerOrEmpty)
        XParse (StartStop -> Maybe PositiveInteger -> MeasureRepeat)
-> XParse StartStop
-> XParse (Maybe PositiveInteger -> MeasureRepeat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse (Maybe PositiveInteger -> MeasureRepeat)
-> XParse (Maybe PositiveInteger) -> XParse MeasureRepeat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"slashes") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)

-- | Smart constructor for 'MeasureRepeat'
mkMeasureRepeat :: PositiveIntegerOrEmpty -> StartStop -> MeasureRepeat
mkMeasureRepeat :: PositiveIntegerOrEmpty -> StartStop -> MeasureRepeat
mkMeasureRepeat PositiveIntegerOrEmpty
a StartStop
b = PositiveIntegerOrEmpty
-> StartStop -> Maybe PositiveInteger -> MeasureRepeat
MeasureRepeat PositiveIntegerOrEmpty
a StartStop
b Maybe PositiveInteger
forall a. Maybe a
Nothing

-- | @measure-style@ /(complex)/
--
-- A measure-style indicates a special way to print partial to multiple measures within a part. This includes multiple rests over several measures, repeats of beats, single, or multiple measures, and use of slash notation.
-- 
-- The multiple-rest and measure-repeat symbols indicate the number of measures covered in the element content. The beat-repeat and slash elements can cover partial measures. All but the multiple-rest element use a type attribute to indicate starting and stopping the use of the style. The optional number attribute specifies the staff number from top to bottom on the system, as with clef.
data MeasureStyle = 
      MeasureStyle {
          MeasureStyle -> Maybe StaffNumber
measureStyleNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , MeasureStyle -> Maybe CommaSeparatedText
measureStyleFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , MeasureStyle -> Maybe FontStyle
measureStyleFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , MeasureStyle -> Maybe FontSize
measureStyleFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , MeasureStyle -> Maybe FontWeight
measureStyleFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , MeasureStyle -> Maybe Color
measureStyleColor :: (Maybe Color) -- ^ /color/ attribute
        , MeasureStyle -> Maybe ID
measureStyleId :: (Maybe ID) -- ^ /id/ attribute
        , MeasureStyle -> ChxMeasureStyle
measureStyleMeasureStyle :: ChxMeasureStyle
       }
    deriving (MeasureStyle -> MeasureStyle -> Bool
(MeasureStyle -> MeasureStyle -> Bool)
-> (MeasureStyle -> MeasureStyle -> Bool) -> Eq MeasureStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MeasureStyle -> MeasureStyle -> Bool
$c/= :: MeasureStyle -> MeasureStyle -> Bool
== :: MeasureStyle -> MeasureStyle -> Bool
$c== :: MeasureStyle -> MeasureStyle -> Bool
Eq,Typeable,(forall x. MeasureStyle -> Rep MeasureStyle x)
-> (forall x. Rep MeasureStyle x -> MeasureStyle)
-> Generic MeasureStyle
forall x. Rep MeasureStyle x -> MeasureStyle
forall x. MeasureStyle -> Rep MeasureStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MeasureStyle x -> MeasureStyle
$cfrom :: forall x. MeasureStyle -> Rep MeasureStyle x
Generic,Int -> MeasureStyle -> ShowS
[MeasureStyle] -> ShowS
MeasureStyle -> String
(Int -> MeasureStyle -> ShowS)
-> (MeasureStyle -> String)
-> ([MeasureStyle] -> ShowS)
-> Show MeasureStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MeasureStyle] -> ShowS
$cshowList :: [MeasureStyle] -> ShowS
show :: MeasureStyle -> String
$cshow :: MeasureStyle -> String
showsPrec :: Int -> MeasureStyle -> ShowS
$cshowsPrec :: Int -> MeasureStyle -> ShowS
Show)
instance EmitXml MeasureStyle where
    emitXml :: MeasureStyle -> XmlRep
emitXml (MeasureStyle Maybe StaffNumber
a Maybe CommaSeparatedText
b Maybe FontStyle
c Maybe FontSize
d Maybe FontWeight
e Maybe Color
f Maybe ID
g ChxMeasureStyle
h) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
g])
        ([ChxMeasureStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxMeasureStyle
h])
parseMeasureStyle :: P.XParse MeasureStyle
parseMeasureStyle :: XParse MeasureStyle
parseMeasureStyle = 
      Maybe StaffNumber
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> ChxMeasureStyle
-> MeasureStyle
MeasureStyle
        (Maybe StaffNumber
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe ID
 -> ChxMeasureStyle
 -> MeasureStyle)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> ChxMeasureStyle
      -> MeasureStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> ChxMeasureStyle
   -> MeasureStyle)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> ChxMeasureStyle
      -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> ChxMeasureStyle
   -> MeasureStyle)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> ChxMeasureStyle
      -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> ChxMeasureStyle
   -> MeasureStyle)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe ID -> ChxMeasureStyle -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe ID -> ChxMeasureStyle -> MeasureStyle)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color -> Maybe ID -> ChxMeasureStyle -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe ID -> ChxMeasureStyle -> MeasureStyle)
-> XParse (Maybe Color)
-> XParse (Maybe ID -> ChxMeasureStyle -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> ChxMeasureStyle -> MeasureStyle)
-> XParse (Maybe ID) -> XParse (ChxMeasureStyle -> MeasureStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxMeasureStyle -> MeasureStyle)
-> XParse ChxMeasureStyle -> XParse MeasureStyle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxMeasureStyle
parseChxMeasureStyle

-- | Smart constructor for 'MeasureStyle'
mkMeasureStyle :: ChxMeasureStyle -> MeasureStyle
mkMeasureStyle :: ChxMeasureStyle -> MeasureStyle
mkMeasureStyle ChxMeasureStyle
h = Maybe StaffNumber
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> ChxMeasureStyle
-> MeasureStyle
MeasureStyle Maybe StaffNumber
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxMeasureStyle
h

-- | @metronome@ /(complex)/
--
-- The metronome type represents metronome marks and other metric relationships. The beat-unit group and per-minute element specify regular metronome marks. The metronome-note and metronome-relation elements allow for the specification of metric modulations and other metric relationships, such as swing tempo marks where two eighths are equated to a quarter note / eighth note triplet. Tied notes can be represented in both types of metronome marks by using the beat-unit-tied and metronome-tied elements. The parentheses attribute indicates whether or not to put the metronome mark in parentheses; its value is no if not specified.
data Metronome = 
      Metronome {
          Metronome -> Maybe YesNo
metronomeParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , Metronome -> Maybe Tenths
metronomeDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Metronome -> Maybe Tenths
metronomeDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Metronome -> Maybe Tenths
metronomeRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Metronome -> Maybe Tenths
metronomeRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Metronome -> Maybe CommaSeparatedText
metronomeFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Metronome -> Maybe FontStyle
metronomeFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Metronome -> Maybe FontSize
metronomeFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Metronome -> Maybe FontWeight
metronomeFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Metronome -> Maybe Color
metronomeColor :: (Maybe Color) -- ^ /color/ attribute
        , Metronome -> Maybe LeftCenterRight
metronomeHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Metronome -> Maybe Valign
metronomeValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Metronome -> Maybe LeftCenterRight
metronomeJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
        , Metronome -> Maybe ID
metronomeId :: (Maybe ID) -- ^ /id/ attribute
        , Metronome -> ChxMetronome
metronomeMetronome :: ChxMetronome
       }
    deriving (Metronome -> Metronome -> Bool
(Metronome -> Metronome -> Bool)
-> (Metronome -> Metronome -> Bool) -> Eq Metronome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metronome -> Metronome -> Bool
$c/= :: Metronome -> Metronome -> Bool
== :: Metronome -> Metronome -> Bool
$c== :: Metronome -> Metronome -> Bool
Eq,Typeable,(forall x. Metronome -> Rep Metronome x)
-> (forall x. Rep Metronome x -> Metronome) -> Generic Metronome
forall x. Rep Metronome x -> Metronome
forall x. Metronome -> Rep Metronome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metronome x -> Metronome
$cfrom :: forall x. Metronome -> Rep Metronome x
Generic,Int -> Metronome -> ShowS
[Metronome] -> ShowS
Metronome -> String
(Int -> Metronome -> ShowS)
-> (Metronome -> String)
-> ([Metronome] -> ShowS)
-> Show Metronome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metronome] -> ShowS
$cshowList :: [Metronome] -> ShowS
show :: Metronome -> String
$cshow :: Metronome -> String
showsPrec :: Int -> Metronome -> ShowS
$cshowsPrec :: Int -> Metronome -> ShowS
Show)
instance EmitXml Metronome where
    emitXml :: Metronome -> XmlRep
emitXml (Metronome Maybe YesNo
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l Maybe LeftCenterRight
m Maybe ID
n ChxMetronome
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
n])
        ([ChxMetronome -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxMetronome
o])
parseMetronome :: P.XParse Metronome
parseMetronome :: XParse Metronome
parseMetronome = 
      Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe LeftCenterRight
-> Maybe ID
-> ChxMetronome
-> Metronome
Metronome
        (Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe LeftCenterRight
 -> Maybe ID
 -> ChxMetronome
 -> Metronome)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe LeftCenterRight
      -> Maybe ID
      -> ChxMetronome
      -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe LeftCenterRight
   -> Maybe ID
   -> ChxMetronome
   -> Metronome)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe LeftCenterRight -> Maybe ID -> ChxMetronome -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe LeftCenterRight -> Maybe ID -> ChxMetronome -> Metronome)
-> XParse (Maybe Valign)
-> XParse
     (Maybe LeftCenterRight -> Maybe ID -> ChxMetronome -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe LeftCenterRight -> Maybe ID -> ChxMetronome -> Metronome)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe ID -> ChxMetronome -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe ID -> ChxMetronome -> Metronome)
-> XParse (Maybe ID) -> XParse (ChxMetronome -> Metronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxMetronome -> Metronome)
-> XParse ChxMetronome -> XParse Metronome
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxMetronome
parseChxMetronome

-- | Smart constructor for 'Metronome'
mkMetronome :: ChxMetronome -> Metronome
mkMetronome :: ChxMetronome -> Metronome
mkMetronome ChxMetronome
o = Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe LeftCenterRight
-> Maybe ID
-> ChxMetronome
-> Metronome
Metronome Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxMetronome
o

-- | @metronome-beam@ /(complex)/
--
-- The metronome-beam type works like the beam type in defining metric relationships, but does not include all the attributes available in the beam type.
data MetronomeBeam = 
      MetronomeBeam {
          MetronomeBeam -> BeamValue
metronomeBeamBeamValue :: BeamValue -- ^ text content
        , MetronomeBeam -> Maybe BeamLevel
metronomeBeamNumber :: (Maybe BeamLevel) -- ^ /number/ attribute
       }
    deriving (MetronomeBeam -> MetronomeBeam -> Bool
(MetronomeBeam -> MetronomeBeam -> Bool)
-> (MetronomeBeam -> MetronomeBeam -> Bool) -> Eq MetronomeBeam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetronomeBeam -> MetronomeBeam -> Bool
$c/= :: MetronomeBeam -> MetronomeBeam -> Bool
== :: MetronomeBeam -> MetronomeBeam -> Bool
$c== :: MetronomeBeam -> MetronomeBeam -> Bool
Eq,Typeable,(forall x. MetronomeBeam -> Rep MetronomeBeam x)
-> (forall x. Rep MetronomeBeam x -> MetronomeBeam)
-> Generic MetronomeBeam
forall x. Rep MetronomeBeam x -> MetronomeBeam
forall x. MetronomeBeam -> Rep MetronomeBeam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetronomeBeam x -> MetronomeBeam
$cfrom :: forall x. MetronomeBeam -> Rep MetronomeBeam x
Generic,Int -> MetronomeBeam -> ShowS
[MetronomeBeam] -> ShowS
MetronomeBeam -> String
(Int -> MetronomeBeam -> ShowS)
-> (MetronomeBeam -> String)
-> ([MetronomeBeam] -> ShowS)
-> Show MetronomeBeam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetronomeBeam] -> ShowS
$cshowList :: [MetronomeBeam] -> ShowS
show :: MetronomeBeam -> String
$cshow :: MetronomeBeam -> String
showsPrec :: Int -> MetronomeBeam -> ShowS
$cshowsPrec :: Int -> MetronomeBeam -> ShowS
Show)
instance EmitXml MetronomeBeam where
    emitXml :: MetronomeBeam -> XmlRep
emitXml (MetronomeBeam BeamValue
a Maybe BeamLevel
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (BeamValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeamValue
a)
        ([XmlRep -> (BeamLevel -> XmlRep) -> Maybe BeamLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (BeamLevel -> XmlRep) -> BeamLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BeamLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe BeamLevel
b])
        []
parseMetronomeBeam :: P.XParse MetronomeBeam
parseMetronomeBeam :: XParse MetronomeBeam
parseMetronomeBeam = 
      BeamValue -> Maybe BeamLevel -> MetronomeBeam
MetronomeBeam
        (BeamValue -> Maybe BeamLevel -> MetronomeBeam)
-> XParse BeamValue -> XParse (Maybe BeamLevel -> MetronomeBeam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse BeamValue) -> XParse BeamValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BeamValue
parseBeamValue)
        XParse (Maybe BeamLevel -> MetronomeBeam)
-> XParse (Maybe BeamLevel) -> XParse MetronomeBeam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BeamLevel -> XParse (Maybe BeamLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse BeamLevel) -> XParse BeamLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BeamLevel
parseBeamLevel)

-- | Smart constructor for 'MetronomeBeam'
mkMetronomeBeam :: BeamValue -> MetronomeBeam
mkMetronomeBeam :: BeamValue -> MetronomeBeam
mkMetronomeBeam BeamValue
a = BeamValue -> Maybe BeamLevel -> MetronomeBeam
MetronomeBeam BeamValue
a Maybe BeamLevel
forall a. Maybe a
Nothing

-- | @metronome-note@ /(complex)/
--
-- The metronome-note type defines the appearance of a note within a metric relationship mark.
data MetronomeNote = 
      MetronomeNote {
          MetronomeNote -> NoteTypeValue
metronomeNoteMetronomeType :: NoteTypeValue -- ^ /metronome-type/ child element
        , MetronomeNote -> [Empty]
metronomeNoteMetronomeDot :: [Empty] -- ^ /metronome-dot/ child element
        , MetronomeNote -> [MetronomeBeam]
metronomeNoteMetronomeBeam :: [MetronomeBeam] -- ^ /metronome-beam/ child element
        , MetronomeNote -> Maybe MetronomeTied
metronomeNoteMetronomeTied :: (Maybe MetronomeTied) -- ^ /metronome-tied/ child element
        , MetronomeNote -> Maybe MetronomeTuplet
metronomeNoteMetronomeTuplet :: (Maybe MetronomeTuplet) -- ^ /metronome-tuplet/ child element
       }
    deriving (MetronomeNote -> MetronomeNote -> Bool
(MetronomeNote -> MetronomeNote -> Bool)
-> (MetronomeNote -> MetronomeNote -> Bool) -> Eq MetronomeNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetronomeNote -> MetronomeNote -> Bool
$c/= :: MetronomeNote -> MetronomeNote -> Bool
== :: MetronomeNote -> MetronomeNote -> Bool
$c== :: MetronomeNote -> MetronomeNote -> Bool
Eq,Typeable,(forall x. MetronomeNote -> Rep MetronomeNote x)
-> (forall x. Rep MetronomeNote x -> MetronomeNote)
-> Generic MetronomeNote
forall x. Rep MetronomeNote x -> MetronomeNote
forall x. MetronomeNote -> Rep MetronomeNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetronomeNote x -> MetronomeNote
$cfrom :: forall x. MetronomeNote -> Rep MetronomeNote x
Generic,Int -> MetronomeNote -> ShowS
[MetronomeNote] -> ShowS
MetronomeNote -> String
(Int -> MetronomeNote -> ShowS)
-> (MetronomeNote -> String)
-> ([MetronomeNote] -> ShowS)
-> Show MetronomeNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetronomeNote] -> ShowS
$cshowList :: [MetronomeNote] -> ShowS
show :: MetronomeNote -> String
$cshow :: MetronomeNote -> String
showsPrec :: Int -> MetronomeNote -> ShowS
$cshowsPrec :: Int -> MetronomeNote -> ShowS
Show)
instance EmitXml MetronomeNote where
    emitXml :: MetronomeNote -> XmlRep
emitXml (MetronomeNote NoteTypeValue
a [Empty]
b [MetronomeBeam]
c Maybe MetronomeTied
d Maybe MetronomeTuplet
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-type" Maybe String
forall a. Maybe a
Nothing) (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Empty -> XmlRep) -> [Empty] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Empty]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (MetronomeBeam -> XmlRep) -> [MetronomeBeam] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-beam" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MetronomeBeam -> XmlRep) -> MetronomeBeam -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MetronomeBeam -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [MetronomeBeam]
c [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MetronomeTied -> XmlRep) -> Maybe MetronomeTied -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-tied" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MetronomeTied -> XmlRep) -> MetronomeTied -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MetronomeTied -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MetronomeTied
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MetronomeTuplet -> XmlRep) -> Maybe MetronomeTuplet -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-tuplet" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MetronomeTuplet -> XmlRep) -> MetronomeTuplet -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MetronomeTuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MetronomeTuplet
e])
parseMetronomeNote :: P.XParse MetronomeNote
parseMetronomeNote :: XParse MetronomeNote
parseMetronomeNote = 
      NoteTypeValue
-> [Empty]
-> [MetronomeBeam]
-> Maybe MetronomeTied
-> Maybe MetronomeTuplet
-> MetronomeNote
MetronomeNote
        (NoteTypeValue
 -> [Empty]
 -> [MetronomeBeam]
 -> Maybe MetronomeTied
 -> Maybe MetronomeTuplet
 -> MetronomeNote)
-> XParse NoteTypeValue
-> XParse
     ([Empty]
      -> [MetronomeBeam]
      -> Maybe MetronomeTied
      -> Maybe MetronomeTuplet
      -> MetronomeNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NoteTypeValue -> XParse NoteTypeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-type") (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue))
        XParse
  ([Empty]
   -> [MetronomeBeam]
   -> Maybe MetronomeTied
   -> Maybe MetronomeTuplet
   -> MetronomeNote)
-> XParse [Empty]
-> XParse
     ([MetronomeBeam]
      -> Maybe MetronomeTied -> Maybe MetronomeTuplet -> MetronomeNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse [Empty]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-dot") (XParse Empty
parseEmpty))
        XParse
  ([MetronomeBeam]
   -> Maybe MetronomeTied -> Maybe MetronomeTuplet -> MetronomeNote)
-> XParse [MetronomeBeam]
-> XParse
     (Maybe MetronomeTied -> Maybe MetronomeTuplet -> MetronomeNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MetronomeBeam -> XParse [MetronomeBeam]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse MetronomeBeam -> XParse MetronomeBeam
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-beam") (XParse MetronomeBeam
parseMetronomeBeam))
        XParse
  (Maybe MetronomeTied -> Maybe MetronomeTuplet -> MetronomeNote)
-> XParse (Maybe MetronomeTied)
-> XParse (Maybe MetronomeTuplet -> MetronomeNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MetronomeTied -> XParse (Maybe MetronomeTied)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MetronomeTied -> XParse MetronomeTied
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-tied") (XParse MetronomeTied
parseMetronomeTied))
        XParse (Maybe MetronomeTuplet -> MetronomeNote)
-> XParse (Maybe MetronomeTuplet) -> XParse MetronomeNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MetronomeTuplet -> XParse (Maybe MetronomeTuplet)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MetronomeTuplet -> XParse MetronomeTuplet
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-tuplet") (XParse MetronomeTuplet
parseMetronomeTuplet))

-- | Smart constructor for 'MetronomeNote'
mkMetronomeNote :: NoteTypeValue -> MetronomeNote
mkMetronomeNote :: NoteTypeValue -> MetronomeNote
mkMetronomeNote NoteTypeValue
a = NoteTypeValue
-> [Empty]
-> [MetronomeBeam]
-> Maybe MetronomeTied
-> Maybe MetronomeTuplet
-> MetronomeNote
MetronomeNote NoteTypeValue
a [] [] Maybe MetronomeTied
forall a. Maybe a
Nothing Maybe MetronomeTuplet
forall a. Maybe a
Nothing

-- | @metronome-tied@ /(complex)/
--
-- The metronome-tied indicates the presence of a tie within a metric relationship mark. As with the tied element, both the start and stop of the tie should be specified, in this case within separate metronome-note elements.
data MetronomeTied = 
      MetronomeTied {
          MetronomeTied -> StartStop
metronomeTiedType :: StartStop -- ^ /type/ attribute
       }
    deriving (MetronomeTied -> MetronomeTied -> Bool
(MetronomeTied -> MetronomeTied -> Bool)
-> (MetronomeTied -> MetronomeTied -> Bool) -> Eq MetronomeTied
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetronomeTied -> MetronomeTied -> Bool
$c/= :: MetronomeTied -> MetronomeTied -> Bool
== :: MetronomeTied -> MetronomeTied -> Bool
$c== :: MetronomeTied -> MetronomeTied -> Bool
Eq,Typeable,(forall x. MetronomeTied -> Rep MetronomeTied x)
-> (forall x. Rep MetronomeTied x -> MetronomeTied)
-> Generic MetronomeTied
forall x. Rep MetronomeTied x -> MetronomeTied
forall x. MetronomeTied -> Rep MetronomeTied x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetronomeTied x -> MetronomeTied
$cfrom :: forall x. MetronomeTied -> Rep MetronomeTied x
Generic,Int -> MetronomeTied -> ShowS
[MetronomeTied] -> ShowS
MetronomeTied -> String
(Int -> MetronomeTied -> ShowS)
-> (MetronomeTied -> String)
-> ([MetronomeTied] -> ShowS)
-> Show MetronomeTied
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetronomeTied] -> ShowS
$cshowList :: [MetronomeTied] -> ShowS
show :: MetronomeTied -> String
$cshow :: MetronomeTied -> String
showsPrec :: Int -> MetronomeTied -> ShowS
$cshowsPrec :: Int -> MetronomeTied -> ShowS
Show)
instance EmitXml MetronomeTied where
    emitXml :: MetronomeTied -> XmlRep
emitXml (MetronomeTied StartStop
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)])
        []
parseMetronomeTied :: P.XParse MetronomeTied
parseMetronomeTied :: XParse MetronomeTied
parseMetronomeTied = 
      StartStop -> MetronomeTied
MetronomeTied
        (StartStop -> MetronomeTied)
-> XParse StartStop -> XParse MetronomeTied
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)

-- | Smart constructor for 'MetronomeTied'
mkMetronomeTied :: StartStop -> MetronomeTied
mkMetronomeTied :: StartStop -> MetronomeTied
mkMetronomeTied StartStop
a = StartStop -> MetronomeTied
MetronomeTied StartStop
a

-- | @metronome-tuplet@ /(complex)/
--
-- The metronome-tuplet type uses the same element structure as the time-modification element along with some attributes from the tuplet element.
data MetronomeTuplet = 
      MetronomeTuplet {
          MetronomeTuplet -> MetronomeTuplet
metronomeTupletTimeModification :: MetronomeTuplet
        , MetronomeTuplet -> StartStop
metronomeTupletType :: StartStop -- ^ /type/ attribute
        , MetronomeTuplet -> Maybe YesNo
metronomeTupletBracket :: (Maybe YesNo) -- ^ /bracket/ attribute
        , MetronomeTuplet -> Maybe ShowTuplet
metronomeTupletShowNumber :: (Maybe ShowTuplet) -- ^ /show-number/ attribute
       }
    deriving (MetronomeTuplet -> MetronomeTuplet -> Bool
(MetronomeTuplet -> MetronomeTuplet -> Bool)
-> (MetronomeTuplet -> MetronomeTuplet -> Bool)
-> Eq MetronomeTuplet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetronomeTuplet -> MetronomeTuplet -> Bool
$c/= :: MetronomeTuplet -> MetronomeTuplet -> Bool
== :: MetronomeTuplet -> MetronomeTuplet -> Bool
$c== :: MetronomeTuplet -> MetronomeTuplet -> Bool
Eq,Typeable,(forall x. MetronomeTuplet -> Rep MetronomeTuplet x)
-> (forall x. Rep MetronomeTuplet x -> MetronomeTuplet)
-> Generic MetronomeTuplet
forall x. Rep MetronomeTuplet x -> MetronomeTuplet
forall x. MetronomeTuplet -> Rep MetronomeTuplet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetronomeTuplet x -> MetronomeTuplet
$cfrom :: forall x. MetronomeTuplet -> Rep MetronomeTuplet x
Generic,Int -> MetronomeTuplet -> ShowS
[MetronomeTuplet] -> ShowS
MetronomeTuplet -> String
(Int -> MetronomeTuplet -> ShowS)
-> (MetronomeTuplet -> String)
-> ([MetronomeTuplet] -> ShowS)
-> Show MetronomeTuplet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetronomeTuplet] -> ShowS
$cshowList :: [MetronomeTuplet] -> ShowS
show :: MetronomeTuplet -> String
$cshow :: MetronomeTuplet -> String
showsPrec :: Int -> MetronomeTuplet -> ShowS
$cshowsPrec :: Int -> MetronomeTuplet -> ShowS
Show)
instance EmitXml MetronomeTuplet where
    emitXml :: MetronomeTuplet -> XmlRep
emitXml (MetronomeTuplet MetronomeTuplet
a StartStop
b Maybe YesNo
c Maybe ShowTuplet
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ShowTuplet -> XmlRep) -> Maybe ShowTuplet -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ShowTuplet -> XmlRep) -> ShowTuplet -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowTuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ShowTuplet
d])
        ([MetronomeTuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MetronomeTuplet
a])
parseMetronomeTuplet :: P.XParse MetronomeTuplet
parseMetronomeTuplet :: XParse MetronomeTuplet
parseMetronomeTuplet = 
      MetronomeTuplet
-> StartStop -> Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet
MetronomeTuplet
        (MetronomeTuplet
 -> StartStop -> Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet)
-> XParse MetronomeTuplet
-> XParse
     (StartStop -> Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse MetronomeTuplet
parseMetronomeTuplet
        XParse
  (StartStop -> Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet)
-> XParse StartStop
-> XParse (Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse (Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet)
-> XParse (Maybe YesNo)
-> XParse (Maybe ShowTuplet -> MetronomeTuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe ShowTuplet -> MetronomeTuplet)
-> XParse (Maybe ShowTuplet) -> XParse MetronomeTuplet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ShowTuplet -> XParse (Maybe ShowTuplet)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"show-number") XParse String -> (String -> XParse ShowTuplet) -> XParse ShowTuplet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ShowTuplet
parseShowTuplet)

-- | Smart constructor for 'MetronomeTuplet'
mkMetronomeTuplet :: MetronomeTuplet -> StartStop -> MetronomeTuplet
mkMetronomeTuplet :: MetronomeTuplet -> StartStop -> MetronomeTuplet
mkMetronomeTuplet MetronomeTuplet
a StartStop
b = MetronomeTuplet
-> StartStop -> Maybe YesNo -> Maybe ShowTuplet -> MetronomeTuplet
MetronomeTuplet MetronomeTuplet
a StartStop
b Maybe YesNo
forall a. Maybe a
Nothing Maybe ShowTuplet
forall a. Maybe a
Nothing

-- | @midi-device@ /(complex)/
--
-- The midi-device type corresponds to the DeviceName meta event in Standard MIDI Files. The optional port attribute is a number from 1 to 16 that can be used with the unofficial MIDI port (or cable) meta event. Unlike the DeviceName meta event, there can be multiple midi-device elements per MusicXML part starting in MusicXML 3.0. The optional id attribute refers to the score-instrument assigned to this device. If missing, the device assignment affects all score-instrument elements in the score-part.
data MidiDevice = 
      MidiDevice {
          MidiDevice -> String
midiDeviceString :: String -- ^ text content
        , MidiDevice -> Maybe Midi16
midiDevicePort :: (Maybe Midi16) -- ^ /port/ attribute
        , MidiDevice -> Maybe IDREF
midiDeviceId :: (Maybe IDREF) -- ^ /id/ attribute
       }
    deriving (MidiDevice -> MidiDevice -> Bool
(MidiDevice -> MidiDevice -> Bool)
-> (MidiDevice -> MidiDevice -> Bool) -> Eq MidiDevice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiDevice -> MidiDevice -> Bool
$c/= :: MidiDevice -> MidiDevice -> Bool
== :: MidiDevice -> MidiDevice -> Bool
$c== :: MidiDevice -> MidiDevice -> Bool
Eq,Typeable,(forall x. MidiDevice -> Rep MidiDevice x)
-> (forall x. Rep MidiDevice x -> MidiDevice) -> Generic MidiDevice
forall x. Rep MidiDevice x -> MidiDevice
forall x. MidiDevice -> Rep MidiDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MidiDevice x -> MidiDevice
$cfrom :: forall x. MidiDevice -> Rep MidiDevice x
Generic,Int -> MidiDevice -> ShowS
[MidiDevice] -> ShowS
MidiDevice -> String
(Int -> MidiDevice -> ShowS)
-> (MidiDevice -> String)
-> ([MidiDevice] -> ShowS)
-> Show MidiDevice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiDevice] -> ShowS
$cshowList :: [MidiDevice] -> ShowS
show :: MidiDevice -> String
$cshow :: MidiDevice -> String
showsPrec :: Int -> MidiDevice -> ShowS
$cshowsPrec :: Int -> MidiDevice -> ShowS
Show)
instance EmitXml MidiDevice where
    emitXml :: MidiDevice -> XmlRep
emitXml (MidiDevice String
a Maybe Midi16
b Maybe IDREF
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Midi16 -> XmlRep) -> Maybe Midi16 -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"port" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Midi16 -> XmlRep) -> Midi16 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Midi16 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Midi16
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (IDREF -> XmlRep) -> Maybe IDREF -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (IDREF -> XmlRep) -> IDREF -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe IDREF
c])
        []
parseMidiDevice :: P.XParse MidiDevice
parseMidiDevice :: XParse MidiDevice
parseMidiDevice = 
      String -> Maybe Midi16 -> Maybe IDREF -> MidiDevice
MidiDevice
        (String -> Maybe Midi16 -> Maybe IDREF -> MidiDevice)
-> XParse String
-> XParse (Maybe Midi16 -> Maybe IDREF -> MidiDevice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Maybe Midi16 -> Maybe IDREF -> MidiDevice)
-> XParse (Maybe Midi16) -> XParse (Maybe IDREF -> MidiDevice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Midi16 -> XParse (Maybe Midi16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"port") XParse String -> (String -> XParse Midi16) -> XParse Midi16
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Midi16
parseMidi16)
        XParse (Maybe IDREF -> MidiDevice)
-> XParse (Maybe IDREF) -> XParse MidiDevice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse IDREF -> XParse (Maybe IDREF)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)

-- | Smart constructor for 'MidiDevice'
mkMidiDevice :: String -> MidiDevice
mkMidiDevice :: String -> MidiDevice
mkMidiDevice String
a = String -> Maybe Midi16 -> Maybe IDREF -> MidiDevice
MidiDevice String
a Maybe Midi16
forall a. Maybe a
Nothing Maybe IDREF
forall a. Maybe a
Nothing

-- | @midi-instrument@ /(complex)/
--
-- The midi-instrument type defines MIDI 1.0 instrument playback. The midi-instrument element can be a part of either the score-instrument element at the start of a part, or the sound element within a part. The id attribute refers to the score-instrument affected by the change.
data MidiInstrument = 
      MidiInstrument {
          MidiInstrument -> IDREF
midiInstrumentId :: IDREF -- ^ /id/ attribute
        , MidiInstrument -> Maybe Midi16
midiInstrumentMidiChannel :: (Maybe Midi16) -- ^ /midi-channel/ child element
        , MidiInstrument -> Maybe String
midiInstrumentMidiName :: (Maybe String) -- ^ /midi-name/ child element
        , MidiInstrument -> Maybe Midi16384
midiInstrumentMidiBank :: (Maybe Midi16384) -- ^ /midi-bank/ child element
        , MidiInstrument -> Maybe Midi128
midiInstrumentMidiProgram :: (Maybe Midi128) -- ^ /midi-program/ child element
        , MidiInstrument -> Maybe Midi128
midiInstrumentMidiUnpitched :: (Maybe Midi128) -- ^ /midi-unpitched/ child element
        , MidiInstrument -> Maybe Percent
midiInstrumentVolume :: (Maybe Percent) -- ^ /volume/ child element
        , MidiInstrument -> Maybe RotationDegrees
midiInstrumentPan :: (Maybe RotationDegrees) -- ^ /pan/ child element
        , MidiInstrument -> Maybe RotationDegrees
midiInstrumentElevation :: (Maybe RotationDegrees) -- ^ /elevation/ child element
       }
    deriving (MidiInstrument -> MidiInstrument -> Bool
(MidiInstrument -> MidiInstrument -> Bool)
-> (MidiInstrument -> MidiInstrument -> Bool) -> Eq MidiInstrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiInstrument -> MidiInstrument -> Bool
$c/= :: MidiInstrument -> MidiInstrument -> Bool
== :: MidiInstrument -> MidiInstrument -> Bool
$c== :: MidiInstrument -> MidiInstrument -> Bool
Eq,Typeable,(forall x. MidiInstrument -> Rep MidiInstrument x)
-> (forall x. Rep MidiInstrument x -> MidiInstrument)
-> Generic MidiInstrument
forall x. Rep MidiInstrument x -> MidiInstrument
forall x. MidiInstrument -> Rep MidiInstrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MidiInstrument x -> MidiInstrument
$cfrom :: forall x. MidiInstrument -> Rep MidiInstrument x
Generic,Int -> MidiInstrument -> ShowS
[MidiInstrument] -> ShowS
MidiInstrument -> String
(Int -> MidiInstrument -> ShowS)
-> (MidiInstrument -> String)
-> ([MidiInstrument] -> ShowS)
-> Show MidiInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiInstrument] -> ShowS
$cshowList :: [MidiInstrument] -> ShowS
show :: MidiInstrument -> String
$cshow :: MidiInstrument -> String
showsPrec :: Int -> MidiInstrument -> ShowS
$cshowsPrec :: Int -> MidiInstrument -> ShowS
Show)
instance EmitXml MidiInstrument where
    emitXml :: MidiInstrument -> XmlRep
emitXml (MidiInstrument IDREF
a Maybe Midi16
b Maybe String
c Maybe Midi16384
d Maybe Midi128
e Maybe Midi128
f Maybe Percent
g Maybe RotationDegrees
h Maybe RotationDegrees
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml IDREF
a)])
        ([XmlRep -> (Midi16 -> XmlRep) -> Maybe Midi16 -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-channel" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Midi16 -> XmlRep) -> Midi16 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Midi16 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Midi16
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Midi16384 -> XmlRep) -> Maybe Midi16384 -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-bank" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Midi16384 -> XmlRep) -> Midi16384 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Midi16384 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Midi16384
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Midi128 -> XmlRep) -> Maybe Midi128 -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-program" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Midi128 -> XmlRep) -> Midi128 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Midi128 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Midi128
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Midi128 -> XmlRep) -> Maybe Midi128 -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-unpitched" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Midi128 -> XmlRep) -> Midi128 -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Midi128 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Midi128
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"volume" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pan" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"elevation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
i])
parseMidiInstrument :: P.XParse MidiInstrument
parseMidiInstrument :: XParse MidiInstrument
parseMidiInstrument = 
      IDREF
-> Maybe Midi16
-> Maybe String
-> Maybe Midi16384
-> Maybe Midi128
-> Maybe Midi128
-> Maybe Percent
-> Maybe RotationDegrees
-> Maybe RotationDegrees
-> MidiInstrument
MidiInstrument
        (IDREF
 -> Maybe Midi16
 -> Maybe String
 -> Maybe Midi16384
 -> Maybe Midi128
 -> Maybe Midi128
 -> Maybe Percent
 -> Maybe RotationDegrees
 -> Maybe RotationDegrees
 -> MidiInstrument)
-> XParse IDREF
-> XParse
     (Maybe Midi16
      -> Maybe String
      -> Maybe Midi16384
      -> Maybe Midi128
      -> Maybe Midi128
      -> Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)
        XParse
  (Maybe Midi16
   -> Maybe String
   -> Maybe Midi16384
   -> Maybe Midi128
   -> Maybe Midi128
   -> Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe Midi16)
-> XParse
     (Maybe String
      -> Maybe Midi16384
      -> Maybe Midi128
      -> Maybe Midi128
      -> Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Midi16 -> XParse (Maybe Midi16)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Midi16 -> XParse Midi16
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-channel") (XParse String
P.xtext XParse String -> (String -> XParse Midi16) -> XParse Midi16
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Midi16
parseMidi16))
        XParse
  (Maybe String
   -> Maybe Midi16384
   -> Maybe Midi128
   -> Maybe Midi128
   -> Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe String)
-> XParse
     (Maybe Midi16384
      -> Maybe Midi128
      -> Maybe Midi128
      -> Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-name") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe Midi16384
   -> Maybe Midi128
   -> Maybe Midi128
   -> Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe Midi16384)
-> XParse
     (Maybe Midi128
      -> Maybe Midi128
      -> Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Midi16384 -> XParse (Maybe Midi16384)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Midi16384 -> XParse Midi16384
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-bank") (XParse String
P.xtext XParse String -> (String -> XParse Midi16384) -> XParse Midi16384
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Midi16384
parseMidi16384))
        XParse
  (Maybe Midi128
   -> Maybe Midi128
   -> Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe Midi128)
-> XParse
     (Maybe Midi128
      -> Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Midi128 -> XParse (Maybe Midi128)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Midi128 -> XParse Midi128
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-program") (XParse String
P.xtext XParse String -> (String -> XParse Midi128) -> XParse Midi128
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Midi128
parseMidi128))
        XParse
  (Maybe Midi128
   -> Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe Midi128)
-> XParse
     (Maybe Percent
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Midi128 -> XParse (Maybe Midi128)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Midi128 -> XParse Midi128
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-unpitched") (XParse String
P.xtext XParse String -> (String -> XParse Midi128) -> XParse Midi128
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Midi128
parseMidi128))
        XParse
  (Maybe Percent
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> MidiInstrument)
-> XParse (Maybe Percent)
-> XParse
     (Maybe RotationDegrees -> Maybe RotationDegrees -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Percent -> XParse Percent
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"volume") (XParse String
P.xtext XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent))
        XParse
  (Maybe RotationDegrees -> Maybe RotationDegrees -> MidiInstrument)
-> XParse (Maybe RotationDegrees)
-> XParse (Maybe RotationDegrees -> MidiInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse RotationDegrees -> XParse RotationDegrees
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pan") (XParse String
P.xtext XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees))
        XParse (Maybe RotationDegrees -> MidiInstrument)
-> XParse (Maybe RotationDegrees) -> XParse MidiInstrument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse RotationDegrees -> XParse RotationDegrees
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"elevation") (XParse String
P.xtext XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees))

-- | Smart constructor for 'MidiInstrument'
mkMidiInstrument :: IDREF -> MidiInstrument
mkMidiInstrument :: IDREF -> MidiInstrument
mkMidiInstrument IDREF
a = IDREF
-> Maybe Midi16
-> Maybe String
-> Maybe Midi16384
-> Maybe Midi128
-> Maybe Midi128
-> Maybe Percent
-> Maybe RotationDegrees
-> Maybe RotationDegrees
-> MidiInstrument
MidiInstrument IDREF
a Maybe Midi16
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Midi16384
forall a. Maybe a
Nothing Maybe Midi128
forall a. Maybe a
Nothing Maybe Midi128
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing

-- | @miscellaneous@ /(complex)/
--
-- If a program has other metadata not yet supported in the MusicXML format, it can go in the miscellaneous element. The miscellaneous type puts each separate part of metadata into its own miscellaneous-field type.
data Miscellaneous = 
      Miscellaneous {
          Miscellaneous -> [MiscellaneousField]
miscellaneousMiscellaneousField :: [MiscellaneousField] -- ^ /miscellaneous-field/ child element
       }
    deriving (Miscellaneous -> Miscellaneous -> Bool
(Miscellaneous -> Miscellaneous -> Bool)
-> (Miscellaneous -> Miscellaneous -> Bool) -> Eq Miscellaneous
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Miscellaneous -> Miscellaneous -> Bool
$c/= :: Miscellaneous -> Miscellaneous -> Bool
== :: Miscellaneous -> Miscellaneous -> Bool
$c== :: Miscellaneous -> Miscellaneous -> Bool
Eq,Typeable,(forall x. Miscellaneous -> Rep Miscellaneous x)
-> (forall x. Rep Miscellaneous x -> Miscellaneous)
-> Generic Miscellaneous
forall x. Rep Miscellaneous x -> Miscellaneous
forall x. Miscellaneous -> Rep Miscellaneous x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Miscellaneous x -> Miscellaneous
$cfrom :: forall x. Miscellaneous -> Rep Miscellaneous x
Generic,Int -> Miscellaneous -> ShowS
[Miscellaneous] -> ShowS
Miscellaneous -> String
(Int -> Miscellaneous -> ShowS)
-> (Miscellaneous -> String)
-> ([Miscellaneous] -> ShowS)
-> Show Miscellaneous
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Miscellaneous] -> ShowS
$cshowList :: [Miscellaneous] -> ShowS
show :: Miscellaneous -> String
$cshow :: Miscellaneous -> String
showsPrec :: Int -> Miscellaneous -> ShowS
$cshowsPrec :: Int -> Miscellaneous -> ShowS
Show)
instance EmitXml Miscellaneous where
    emitXml :: Miscellaneous -> XmlRep
emitXml (Miscellaneous [MiscellaneousField]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((MiscellaneousField -> XmlRep) -> [MiscellaneousField] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"miscellaneous-field" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MiscellaneousField -> XmlRep) -> MiscellaneousField -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MiscellaneousField -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [MiscellaneousField]
a)
parseMiscellaneous :: P.XParse Miscellaneous
parseMiscellaneous :: XParse Miscellaneous
parseMiscellaneous = 
      [MiscellaneousField] -> Miscellaneous
Miscellaneous
        ([MiscellaneousField] -> Miscellaneous)
-> XParse [MiscellaneousField] -> XParse Miscellaneous
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse MiscellaneousField -> XParse [MiscellaneousField]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse MiscellaneousField -> XParse MiscellaneousField
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"miscellaneous-field") (XParse MiscellaneousField
parseMiscellaneousField))

-- | Smart constructor for 'Miscellaneous'
mkMiscellaneous :: Miscellaneous
mkMiscellaneous :: Miscellaneous
mkMiscellaneous = [MiscellaneousField] -> Miscellaneous
Miscellaneous []

-- | @miscellaneous-field@ /(complex)/
--
-- If a program has other metadata not yet supported in the MusicXML format, each type of metadata can go in a miscellaneous-field element. The required name attribute indicates the type of metadata the element content represents.
data MiscellaneousField = 
      MiscellaneousField {
          MiscellaneousField -> String
miscellaneousFieldString :: String -- ^ text content
        , MiscellaneousField -> Token
miscellaneousFieldName :: Token -- ^ /name/ attribute
       }
    deriving (MiscellaneousField -> MiscellaneousField -> Bool
(MiscellaneousField -> MiscellaneousField -> Bool)
-> (MiscellaneousField -> MiscellaneousField -> Bool)
-> Eq MiscellaneousField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MiscellaneousField -> MiscellaneousField -> Bool
$c/= :: MiscellaneousField -> MiscellaneousField -> Bool
== :: MiscellaneousField -> MiscellaneousField -> Bool
$c== :: MiscellaneousField -> MiscellaneousField -> Bool
Eq,Typeable,(forall x. MiscellaneousField -> Rep MiscellaneousField x)
-> (forall x. Rep MiscellaneousField x -> MiscellaneousField)
-> Generic MiscellaneousField
forall x. Rep MiscellaneousField x -> MiscellaneousField
forall x. MiscellaneousField -> Rep MiscellaneousField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MiscellaneousField x -> MiscellaneousField
$cfrom :: forall x. MiscellaneousField -> Rep MiscellaneousField x
Generic,Int -> MiscellaneousField -> ShowS
[MiscellaneousField] -> ShowS
MiscellaneousField -> String
(Int -> MiscellaneousField -> ShowS)
-> (MiscellaneousField -> String)
-> ([MiscellaneousField] -> ShowS)
-> Show MiscellaneousField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MiscellaneousField] -> ShowS
$cshowList :: [MiscellaneousField] -> ShowS
show :: MiscellaneousField -> String
$cshow :: MiscellaneousField -> String
showsPrec :: Int -> MiscellaneousField -> ShowS
$cshowsPrec :: Int -> MiscellaneousField -> ShowS
Show)
instance EmitXml MiscellaneousField where
    emitXml :: MiscellaneousField -> XmlRep
emitXml (MiscellaneousField String
a Token
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"name" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
b)])
        []
parseMiscellaneousField :: P.XParse MiscellaneousField
parseMiscellaneousField :: XParse MiscellaneousField
parseMiscellaneousField = 
      String -> Token -> MiscellaneousField
MiscellaneousField
        (String -> Token -> MiscellaneousField)
-> XParse String -> XParse (Token -> MiscellaneousField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Token -> MiscellaneousField)
-> XParse Token -> XParse MiscellaneousField
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"name") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'MiscellaneousField'
mkMiscellaneousField :: String -> Token -> MiscellaneousField
mkMiscellaneousField :: String -> Token -> MiscellaneousField
mkMiscellaneousField String
a Token
b = String -> Token -> MiscellaneousField
MiscellaneousField String
a Token
b

-- | @mordent@ /(complex)/
--
-- The mordent type is used for both represents the mordent sign with the vertical line and the inverted-mordent sign without the line. The long attribute is "no" by default. The approach and departure attributes are used for compound ornaments, indicating how the beginning and ending of the ornament look relative to the main part of the mordent.
data Mordent = 
      Mordent {
          Mordent -> Mordent
mordentEmptyTrillSound :: Mordent
        , Mordent -> Maybe YesNo
mordentLong :: (Maybe YesNo) -- ^ /long/ attribute
        , Mordent -> Maybe AboveBelow
mordentApproach :: (Maybe AboveBelow) -- ^ /approach/ attribute
        , Mordent -> Maybe AboveBelow
mordentDeparture :: (Maybe AboveBelow) -- ^ /departure/ attribute
       }
    deriving (Mordent -> Mordent -> Bool
(Mordent -> Mordent -> Bool)
-> (Mordent -> Mordent -> Bool) -> Eq Mordent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mordent -> Mordent -> Bool
$c/= :: Mordent -> Mordent -> Bool
== :: Mordent -> Mordent -> Bool
$c== :: Mordent -> Mordent -> Bool
Eq,Typeable,(forall x. Mordent -> Rep Mordent x)
-> (forall x. Rep Mordent x -> Mordent) -> Generic Mordent
forall x. Rep Mordent x -> Mordent
forall x. Mordent -> Rep Mordent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mordent x -> Mordent
$cfrom :: forall x. Mordent -> Rep Mordent x
Generic,Int -> Mordent -> ShowS
[Mordent] -> ShowS
Mordent -> String
(Int -> Mordent -> ShowS)
-> (Mordent -> String) -> ([Mordent] -> ShowS) -> Show Mordent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mordent] -> ShowS
$cshowList :: [Mordent] -> ShowS
show :: Mordent -> String
$cshow :: Mordent -> String
showsPrec :: Int -> Mordent -> ShowS
$cshowsPrec :: Int -> Mordent -> ShowS
Show)
instance EmitXml Mordent where
    emitXml :: Mordent -> XmlRep
emitXml (Mordent Mordent
a Maybe YesNo
b Maybe AboveBelow
c Maybe AboveBelow
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"long" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"approach" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"departure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
d])
        ([Mordent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Mordent
a])
parseMordent :: P.XParse Mordent
parseMordent :: XParse Mordent
parseMordent = 
      Mordent
-> Maybe YesNo -> Maybe AboveBelow -> Maybe AboveBelow -> Mordent
Mordent
        (Mordent
 -> Maybe YesNo -> Maybe AboveBelow -> Maybe AboveBelow -> Mordent)
-> XParse Mordent
-> XParse
     (Maybe YesNo -> Maybe AboveBelow -> Maybe AboveBelow -> Mordent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Mordent
parseMordent
        XParse
  (Maybe YesNo -> Maybe AboveBelow -> Maybe AboveBelow -> Mordent)
-> XParse (Maybe YesNo)
-> XParse (Maybe AboveBelow -> Maybe AboveBelow -> Mordent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"long") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe AboveBelow -> Maybe AboveBelow -> Mordent)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe AboveBelow -> Mordent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"approach") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe AboveBelow -> Mordent)
-> XParse (Maybe AboveBelow) -> XParse Mordent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"departure") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'Mordent'
mkMordent :: Mordent -> Mordent
mkMordent :: Mordent -> Mordent
mkMordent Mordent
a = Mordent
-> Maybe YesNo -> Maybe AboveBelow -> Maybe AboveBelow -> Mordent
Mordent Mordent
a Maybe YesNo
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @multiple-rest@ /(complex)/
--
-- The text of the multiple-rest type indicates the number of measures in the multiple rest. Multiple rests may use the 1-bar / 2-bar / 4-bar rest symbols, or a single shape. The use-symbols attribute indicates which to use; it is no if not specified.
data MultipleRest = 
      MultipleRest {
          MultipleRest -> PositiveIntegerOrEmpty
multipleRestPositiveIntegerOrEmpty :: PositiveIntegerOrEmpty -- ^ text content
        , MultipleRest -> Maybe YesNo
multipleRestUseSymbols :: (Maybe YesNo) -- ^ /use-symbols/ attribute
       }
    deriving (MultipleRest -> MultipleRest -> Bool
(MultipleRest -> MultipleRest -> Bool)
-> (MultipleRest -> MultipleRest -> Bool) -> Eq MultipleRest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultipleRest -> MultipleRest -> Bool
$c/= :: MultipleRest -> MultipleRest -> Bool
== :: MultipleRest -> MultipleRest -> Bool
$c== :: MultipleRest -> MultipleRest -> Bool
Eq,Typeable,(forall x. MultipleRest -> Rep MultipleRest x)
-> (forall x. Rep MultipleRest x -> MultipleRest)
-> Generic MultipleRest
forall x. Rep MultipleRest x -> MultipleRest
forall x. MultipleRest -> Rep MultipleRest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MultipleRest x -> MultipleRest
$cfrom :: forall x. MultipleRest -> Rep MultipleRest x
Generic,Int -> MultipleRest -> ShowS
[MultipleRest] -> ShowS
MultipleRest -> String
(Int -> MultipleRest -> ShowS)
-> (MultipleRest -> String)
-> ([MultipleRest] -> ShowS)
-> Show MultipleRest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MultipleRest] -> ShowS
$cshowList :: [MultipleRest] -> ShowS
show :: MultipleRest -> String
$cshow :: MultipleRest -> String
showsPrec :: Int -> MultipleRest -> ShowS
$cshowsPrec :: Int -> MultipleRest -> ShowS
Show)
instance EmitXml MultipleRest where
    emitXml :: MultipleRest -> XmlRep
emitXml (MultipleRest PositiveIntegerOrEmpty
a Maybe YesNo
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (PositiveIntegerOrEmpty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveIntegerOrEmpty
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"use-symbols" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b])
        []
parseMultipleRest :: P.XParse MultipleRest
parseMultipleRest :: XParse MultipleRest
parseMultipleRest = 
      PositiveIntegerOrEmpty -> Maybe YesNo -> MultipleRest
MultipleRest
        (PositiveIntegerOrEmpty -> Maybe YesNo -> MultipleRest)
-> XParse PositiveIntegerOrEmpty
-> XParse (Maybe YesNo -> MultipleRest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse PositiveIntegerOrEmpty)
-> XParse PositiveIntegerOrEmpty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveIntegerOrEmpty
parsePositiveIntegerOrEmpty)
        XParse (Maybe YesNo -> MultipleRest)
-> XParse (Maybe YesNo) -> XParse MultipleRest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"use-symbols") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)

-- | Smart constructor for 'MultipleRest'
mkMultipleRest :: PositiveIntegerOrEmpty -> MultipleRest
mkMultipleRest :: PositiveIntegerOrEmpty -> MultipleRest
mkMultipleRest PositiveIntegerOrEmpty
a = PositiveIntegerOrEmpty -> Maybe YesNo -> MultipleRest
MultipleRest PositiveIntegerOrEmpty
a Maybe YesNo
forall a. Maybe a
Nothing

-- | @name-display@ /(complex)/
--
-- The name-display type is used for exact formatting of multi-font text in part and group names to the left of the system. The print-object attribute can be used to determine what, if anything, is printed at the start of each system. Enclosure for the display-text element is none by default. Language for the display-text element is Italian ("it") by default.
data NameDisplay = 
      NameDisplay {
          NameDisplay -> Maybe YesNo
nameDisplayPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , NameDisplay -> [ChxNameDisplay]
nameDisplayNameDisplay :: [ChxNameDisplay]
       }
    deriving (NameDisplay -> NameDisplay -> Bool
(NameDisplay -> NameDisplay -> Bool)
-> (NameDisplay -> NameDisplay -> Bool) -> Eq NameDisplay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameDisplay -> NameDisplay -> Bool
$c/= :: NameDisplay -> NameDisplay -> Bool
== :: NameDisplay -> NameDisplay -> Bool
$c== :: NameDisplay -> NameDisplay -> Bool
Eq,Typeable,(forall x. NameDisplay -> Rep NameDisplay x)
-> (forall x. Rep NameDisplay x -> NameDisplay)
-> Generic NameDisplay
forall x. Rep NameDisplay x -> NameDisplay
forall x. NameDisplay -> Rep NameDisplay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameDisplay x -> NameDisplay
$cfrom :: forall x. NameDisplay -> Rep NameDisplay x
Generic,Int -> NameDisplay -> ShowS
[NameDisplay] -> ShowS
NameDisplay -> String
(Int -> NameDisplay -> ShowS)
-> (NameDisplay -> String)
-> ([NameDisplay] -> ShowS)
-> Show NameDisplay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameDisplay] -> ShowS
$cshowList :: [NameDisplay] -> ShowS
show :: NameDisplay -> String
$cshow :: NameDisplay -> String
showsPrec :: Int -> NameDisplay -> ShowS
$cshowsPrec :: Int -> NameDisplay -> ShowS
Show)
instance EmitXml NameDisplay where
    emitXml :: NameDisplay -> XmlRep
emitXml (NameDisplay Maybe YesNo
a [ChxNameDisplay]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a])
        ([[ChxNameDisplay] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxNameDisplay]
b])
parseNameDisplay :: P.XParse NameDisplay
parseNameDisplay :: XParse NameDisplay
parseNameDisplay = 
      Maybe YesNo -> [ChxNameDisplay] -> NameDisplay
NameDisplay
        (Maybe YesNo -> [ChxNameDisplay] -> NameDisplay)
-> XParse (Maybe YesNo) -> XParse ([ChxNameDisplay] -> NameDisplay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse ([ChxNameDisplay] -> NameDisplay)
-> XParse [ChxNameDisplay] -> XParse NameDisplay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxNameDisplay -> XParse [ChxNameDisplay]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxNameDisplay
parseChxNameDisplay)

-- | Smart constructor for 'NameDisplay'
mkNameDisplay :: NameDisplay
mkNameDisplay :: NameDisplay
mkNameDisplay = Maybe YesNo -> [ChxNameDisplay] -> NameDisplay
NameDisplay Maybe YesNo
forall a. Maybe a
Nothing []

-- | @non-arpeggiate@ /(complex)/
--
-- The non-arpeggiate type indicates that this note is at the top or bottom of a bracket indicating to not arpeggiate these notes. Since this does not involve playback, it is only used on the top or bottom notes, not on each note as for the arpeggiate type.
data NonArpeggiate = 
      NonArpeggiate {
          NonArpeggiate -> TopBottom
nonArpeggiateType :: TopBottom -- ^ /type/ attribute
        , NonArpeggiate -> Maybe NumberLevel
nonArpeggiateNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , NonArpeggiate -> Maybe Tenths
nonArpeggiateDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , NonArpeggiate -> Maybe Tenths
nonArpeggiateDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , NonArpeggiate -> Maybe Tenths
nonArpeggiateRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , NonArpeggiate -> Maybe Tenths
nonArpeggiateRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , NonArpeggiate -> Maybe AboveBelow
nonArpeggiatePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , NonArpeggiate -> Maybe Color
nonArpeggiateColor :: (Maybe Color) -- ^ /color/ attribute
        , NonArpeggiate -> Maybe ID
nonArpeggiateId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (NonArpeggiate -> NonArpeggiate -> Bool
(NonArpeggiate -> NonArpeggiate -> Bool)
-> (NonArpeggiate -> NonArpeggiate -> Bool) -> Eq NonArpeggiate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonArpeggiate -> NonArpeggiate -> Bool
$c/= :: NonArpeggiate -> NonArpeggiate -> Bool
== :: NonArpeggiate -> NonArpeggiate -> Bool
$c== :: NonArpeggiate -> NonArpeggiate -> Bool
Eq,Typeable,(forall x. NonArpeggiate -> Rep NonArpeggiate x)
-> (forall x. Rep NonArpeggiate x -> NonArpeggiate)
-> Generic NonArpeggiate
forall x. Rep NonArpeggiate x -> NonArpeggiate
forall x. NonArpeggiate -> Rep NonArpeggiate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonArpeggiate x -> NonArpeggiate
$cfrom :: forall x. NonArpeggiate -> Rep NonArpeggiate x
Generic,Int -> NonArpeggiate -> ShowS
[NonArpeggiate] -> ShowS
NonArpeggiate -> String
(Int -> NonArpeggiate -> ShowS)
-> (NonArpeggiate -> String)
-> ([NonArpeggiate] -> ShowS)
-> Show NonArpeggiate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonArpeggiate] -> ShowS
$cshowList :: [NonArpeggiate] -> ShowS
show :: NonArpeggiate -> String
$cshow :: NonArpeggiate -> String
showsPrec :: Int -> NonArpeggiate -> ShowS
$cshowsPrec :: Int -> NonArpeggiate -> ShowS
Show)
instance EmitXml NonArpeggiate where
    emitXml :: NonArpeggiate -> XmlRep
emitXml (NonArpeggiate TopBottom
a Maybe NumberLevel
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe AboveBelow
g Maybe Color
h Maybe ID
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (TopBottom -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TopBottom
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
i])
        []
parseNonArpeggiate :: P.XParse NonArpeggiate
parseNonArpeggiate :: XParse NonArpeggiate
parseNonArpeggiate = 
      TopBottom
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe ID
-> NonArpeggiate
NonArpeggiate
        (TopBottom
 -> Maybe NumberLevel
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe Color
 -> Maybe ID
 -> NonArpeggiate)
-> XParse TopBottom
-> XParse
     (Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> NonArpeggiate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse TopBottom) -> XParse TopBottom
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TopBottom
parseTopBottom)
        XParse
  (Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> NonArpeggiate)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> NonArpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> NonArpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe ID
      -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe ID
   -> NonArpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow -> Maybe Color -> Maybe ID -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow -> Maybe Color -> Maybe ID -> NonArpeggiate)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow -> Maybe Color -> Maybe ID -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow -> Maybe Color -> Maybe ID -> NonArpeggiate)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe Color -> Maybe ID -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe Color -> Maybe ID -> NonArpeggiate)
-> XParse (Maybe Color) -> XParse (Maybe ID -> NonArpeggiate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> NonArpeggiate)
-> XParse (Maybe ID) -> XParse NonArpeggiate
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'NonArpeggiate'
mkNonArpeggiate :: TopBottom -> NonArpeggiate
mkNonArpeggiate :: TopBottom -> NonArpeggiate
mkNonArpeggiate TopBottom
a = TopBottom
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe ID
-> NonArpeggiate
NonArpeggiate TopBottom
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @notations@ /(complex)/
--
-- Notations refer to musical notations, not XML notations. Multiple notations are allowed in order to represent multiple editorial levels. The print-object attribute, added in Version 3.0, allows notations to represent details of performance technique, such as fingerings, without having them appear in the score.
data Notations = 
      Notations {
          Notations -> Maybe YesNo
notationsPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Notations -> Maybe ID
notationsId :: (Maybe ID) -- ^ /id/ attribute
        , Notations -> Editorial
notationsEditorial :: Editorial
        , Notations -> [ChxNotations]
notationsNotations :: [ChxNotations]
       }
    deriving (Notations -> Notations -> Bool
(Notations -> Notations -> Bool)
-> (Notations -> Notations -> Bool) -> Eq Notations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notations -> Notations -> Bool
$c/= :: Notations -> Notations -> Bool
== :: Notations -> Notations -> Bool
$c== :: Notations -> Notations -> Bool
Eq,Typeable,(forall x. Notations -> Rep Notations x)
-> (forall x. Rep Notations x -> Notations) -> Generic Notations
forall x. Rep Notations x -> Notations
forall x. Notations -> Rep Notations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Notations x -> Notations
$cfrom :: forall x. Notations -> Rep Notations x
Generic,Int -> Notations -> ShowS
[Notations] -> ShowS
Notations -> String
(Int -> Notations -> ShowS)
-> (Notations -> String)
-> ([Notations] -> ShowS)
-> Show Notations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notations] -> ShowS
$cshowList :: [Notations] -> ShowS
show :: Notations -> String
$cshow :: Notations -> String
showsPrec :: Int -> Notations -> ShowS
$cshowsPrec :: Int -> Notations -> ShowS
Show)
instance EmitXml Notations where
    emitXml :: Notations -> XmlRep
emitXml (Notations Maybe YesNo
a Maybe ID
b Editorial
c [ChxNotations]
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
b])
        ([Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [[ChxNotations] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxNotations]
d])
parseNotations :: P.XParse Notations
parseNotations :: XParse Notations
parseNotations = 
      Maybe YesNo -> Maybe ID -> Editorial -> [ChxNotations] -> Notations
Notations
        (Maybe YesNo
 -> Maybe ID -> Editorial -> [ChxNotations] -> Notations)
-> XParse (Maybe YesNo)
-> XParse (Maybe ID -> Editorial -> [ChxNotations] -> Notations)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe ID -> Editorial -> [ChxNotations] -> Notations)
-> XParse (Maybe ID)
-> XParse (Editorial -> [ChxNotations] -> Notations)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (Editorial -> [ChxNotations] -> Notations)
-> XParse Editorial -> XParse ([ChxNotations] -> Notations)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial
        XParse ([ChxNotations] -> Notations)
-> XParse [ChxNotations] -> XParse Notations
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxNotations -> XParse [ChxNotations]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxNotations
parseChxNotations)

-- | Smart constructor for 'Notations'
mkNotations :: Editorial -> Notations
mkNotations :: Editorial -> Notations
mkNotations Editorial
c = Maybe YesNo -> Maybe ID -> Editorial -> [ChxNotations] -> Notations
Notations Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Editorial
c []

-- | @note@ /(complex)/
--
-- Notes are the most common type of MusicXML data. The MusicXML format keeps the MuseData distinction between elements used for sound information and elements used for notation information (e.g., tie is used for sound, tied for notation). Thus grace notes do not have a duration element. Cue notes have a duration element, as do forward elements, but no tie elements. Having these two types of information available can make interchange considerably easier, as some programs handle one type of information much more readily than the other.
--
-- @
-- 
-- The print-leger attribute is used to indicate whether leger lines are printed. Notes without leger lines are used to indicate indeterminate high and low notes. By default, it is set to yes. If print-object is set to no, print-leger is interpreted to also be set to no if not present. This attribute is ignored for rests.
-- 
-- The dynamics and end-dynamics attributes correspond to MIDI 1.0's Note On and Note Off velocities, respectively. They are expressed in terms of percentages of the default forte value (90 for MIDI 1.0).
-- 
-- The attack and release attributes are used to alter the starting and stopping time of the note from when it would otherwise occur based on the flow of durations - information that is specific to a performance. They are expressed in terms of divisions, either positive or negative. A note that starts a tie should not have a release attribute, and a note that stops a tie should not have an attack attribute. The attack and release attributes are independent of each other. The attack attribute only changes the starting time of a note, and the release attribute only changes the stopping time of a note.
-- 
-- If a note is played only particular times through a repeat, the time-only attribute shows which times to play the note.
-- 
-- The pizzicato attribute is used when just this note is sounded pizzicato, vs. the pizzicato element which changes overall playback between pizzicato and arco.
-- @
data Note = 
      Note {
          Note -> Maybe YesNo
notePrintLeger :: (Maybe YesNo) -- ^ /print-leger/ attribute
        , Note -> Maybe NonNegativeDecimal
noteDynamics :: (Maybe NonNegativeDecimal) -- ^ /dynamics/ attribute
        , Note -> Maybe NonNegativeDecimal
noteEndDynamics :: (Maybe NonNegativeDecimal) -- ^ /end-dynamics/ attribute
        , Note -> Maybe Divisions
noteAttack :: (Maybe Divisions) -- ^ /attack/ attribute
        , Note -> Maybe Divisions
noteRelease :: (Maybe Divisions) -- ^ /release/ attribute
        , Note -> Maybe TimeOnly
noteTimeOnly :: (Maybe TimeOnly) -- ^ /time-only/ attribute
        , Note -> Maybe YesNo
notePizzicato :: (Maybe YesNo) -- ^ /pizzicato/ attribute
        , Note -> Maybe Tenths
noteDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Note -> Maybe Tenths
noteDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Note -> Maybe Tenths
noteRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Note -> Maybe Tenths
noteRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Note -> Maybe CommaSeparatedText
noteFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Note -> Maybe FontStyle
noteFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Note -> Maybe FontSize
noteFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Note -> Maybe FontWeight
noteFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Note -> Maybe Color
noteColor :: (Maybe Color) -- ^ /color/ attribute
        , Note -> Maybe YesNo
notePrintDot :: (Maybe YesNo) -- ^ /print-dot/ attribute
        , Note -> Maybe YesNo
notePrintLyric :: (Maybe YesNo) -- ^ /print-lyric/ attribute
        , Note -> Maybe YesNo
notePrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Note -> Maybe YesNo
notePrintSpacing :: (Maybe YesNo) -- ^ /print-spacing/ attribute
        , Note -> Maybe ID
noteId :: (Maybe ID) -- ^ /id/ attribute
        , Note -> ChxNote
noteNote :: ChxNote
        , Note -> Maybe Instrument
noteInstrument :: (Maybe Instrument) -- ^ /instrument/ child element
        , Note -> EditorialVoice
noteEditorialVoice :: EditorialVoice
        , Note -> Maybe NoteType
noteType :: (Maybe NoteType) -- ^ /type/ child element
        , Note -> [EmptyPlacement]
noteDot :: [EmptyPlacement] -- ^ /dot/ child element
        , Note -> Maybe Accidental
noteAccidental :: (Maybe Accidental) -- ^ /accidental/ child element
        , Note -> Maybe TimeModification
noteTimeModification :: (Maybe TimeModification) -- ^ /time-modification/ child element
        , Note -> Maybe Stem
noteStem :: (Maybe Stem) -- ^ /stem/ child element
        , Note -> Maybe Notehead
noteNotehead :: (Maybe Notehead) -- ^ /notehead/ child element
        , Note -> Maybe NoteheadText
noteNoteheadText :: (Maybe NoteheadText) -- ^ /notehead-text/ child element
        , Note -> Maybe Staff
noteStaff :: (Maybe Staff)
        , Note -> [Beam]
noteBeam :: [Beam] -- ^ /beam/ child element
        , Note -> [Notations]
noteNotations :: [Notations] -- ^ /notations/ child element
        , Note -> [Lyric]
noteLyric :: [Lyric] -- ^ /lyric/ child element
        , Note -> Maybe Play
notePlay :: (Maybe Play) -- ^ /play/ child element
       }
    deriving (Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq,Typeable,(forall x. Note -> Rep Note x)
-> (forall x. Rep Note x -> Note) -> Generic Note
forall x. Rep Note x -> Note
forall x. Note -> Rep Note x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Note x -> Note
$cfrom :: forall x. Note -> Rep Note x
Generic,Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
(Int -> Note -> ShowS)
-> (Note -> String) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)
instance EmitXml Note where
    emitXml :: Note -> XmlRep
emitXml (Note Maybe YesNo
a Maybe NonNegativeDecimal
b Maybe NonNegativeDecimal
c Maybe Divisions
d Maybe Divisions
e Maybe TimeOnly
f Maybe YesNo
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe Tenths
k Maybe CommaSeparatedText
l Maybe FontStyle
m Maybe FontSize
n Maybe FontWeight
o Maybe Color
p Maybe YesNo
q Maybe YesNo
r Maybe YesNo
s Maybe YesNo
t Maybe ID
u ChxNote
v Maybe Instrument
w EditorialVoice
x Maybe NoteType
y [EmptyPlacement]
z Maybe Accidental
a1 Maybe TimeModification
b1 Maybe Stem
c1 Maybe Notehead
d1 Maybe NoteheadText
e1 Maybe Staff
f1 [Beam]
g1 [Notations]
h1 [Lyric]
i1 Maybe Play
j1) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-leger" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeDecimal -> XmlRep)
-> Maybe NonNegativeDecimal
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dynamics" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeDecimal -> XmlRep) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeDecimal
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeDecimal -> XmlRep)
-> Maybe NonNegativeDecimal
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"end-dynamics" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeDecimal -> XmlRep) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeDecimal
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"attack" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"release" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TimeOnly -> XmlRep) -> Maybe TimeOnly -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"time-only" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TimeOnly -> XmlRep) -> TimeOnly -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeOnly -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeOnly
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"pizzicato" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-lyric" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
t] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
u])
        ([ChxNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxNote
v] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Instrument -> XmlRep) -> Maybe Instrument -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"instrument" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Instrument -> XmlRep) -> Instrument -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Instrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Instrument
w] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [EditorialVoice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EditorialVoice
x] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NoteType -> XmlRep) -> Maybe NoteType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NoteType -> XmlRep) -> NoteType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NoteType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NoteType
y] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (EmptyPlacement -> XmlRep) -> [EmptyPlacement] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EmptyPlacement -> XmlRep) -> EmptyPlacement -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [EmptyPlacement]
z [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Accidental -> XmlRep) -> Maybe Accidental -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accidental" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Accidental -> XmlRep) -> Accidental -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Accidental -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Accidental
a1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TimeModification -> XmlRep) -> Maybe TimeModification -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"time-modification" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeModification -> XmlRep) -> TimeModification -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeModification -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeModification
b1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Stem -> XmlRep) -> Maybe Stem -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stem" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Stem -> XmlRep) -> Stem -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Stem -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Stem
c1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Notehead -> XmlRep) -> Maybe Notehead -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"notehead" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Notehead -> XmlRep) -> Notehead -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Notehead -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Notehead
d1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NoteheadText -> XmlRep) -> Maybe NoteheadText -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"notehead-text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NoteheadText -> XmlRep) -> NoteheadText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NoteheadText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NoteheadText
e1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe Staff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Staff
f1] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Beam -> XmlRep) -> [Beam] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beam" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Beam -> XmlRep) -> Beam -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Beam -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Beam]
g1 [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Notations -> XmlRep) -> [Notations] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"notations" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Notations -> XmlRep) -> Notations -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Notations -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Notations]
h1 [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Lyric -> XmlRep) -> [Lyric] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"lyric" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Lyric -> XmlRep) -> Lyric -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lyric -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Lyric]
i1 [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Play -> XmlRep) -> Maybe Play -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"play" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Play -> XmlRep) -> Play -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Play -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Play
j1])
parseNote :: P.XParse Note
parseNote :: XParse Note
parseNote = 
      Maybe YesNo
-> Maybe NonNegativeDecimal
-> Maybe NonNegativeDecimal
-> Maybe Divisions
-> Maybe Divisions
-> Maybe TimeOnly
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe ID
-> ChxNote
-> Maybe Instrument
-> EditorialVoice
-> Maybe NoteType
-> [EmptyPlacement]
-> Maybe Accidental
-> Maybe TimeModification
-> Maybe Stem
-> Maybe Notehead
-> Maybe NoteheadText
-> Maybe Staff
-> [Beam]
-> [Notations]
-> [Lyric]
-> Maybe Play
-> Note
Note
        (Maybe YesNo
 -> Maybe NonNegativeDecimal
 -> Maybe NonNegativeDecimal
 -> Maybe Divisions
 -> Maybe Divisions
 -> Maybe TimeOnly
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe ID
 -> ChxNote
 -> Maybe Instrument
 -> EditorialVoice
 -> Maybe NoteType
 -> [EmptyPlacement]
 -> Maybe Accidental
 -> Maybe TimeModification
 -> Maybe Stem
 -> Maybe Notehead
 -> Maybe NoteheadText
 -> Maybe Staff
 -> [Beam]
 -> [Notations]
 -> [Lyric]
 -> Maybe Play
 -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe NonNegativeDecimal
      -> Maybe NonNegativeDecimal
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-leger") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe NonNegativeDecimal
   -> Maybe NonNegativeDecimal
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe NonNegativeDecimal)
-> XParse
     (Maybe NonNegativeDecimal
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeDecimal -> XParse (Maybe NonNegativeDecimal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dynamics") XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal)
        XParse
  (Maybe NonNegativeDecimal
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe NonNegativeDecimal)
-> XParse
     (Maybe Divisions
      -> Maybe Divisions
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeDecimal -> XParse (Maybe NonNegativeDecimal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"end-dynamics") XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal)
        XParse
  (Maybe Divisions
   -> Maybe Divisions
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Divisions)
-> XParse
     (Maybe Divisions
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"attack") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse
  (Maybe Divisions
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Divisions)
-> XParse
     (Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"release") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse
  (Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe TimeOnly)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeOnly -> XParse (Maybe TimeOnly)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"time-only") XParse String -> (String -> XParse TimeOnly) -> XParse TimeOnly
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeOnly
parseTimeOnly)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"pizzicato") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-dot") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-lyric") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ID
      -> ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-spacing") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ID
   -> ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe ID)
-> XParse
     (ChxNote
      -> Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (ChxNote
   -> Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse ChxNote
-> XParse
     (Maybe Instrument
      -> EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxNote
parseChxNote
        XParse
  (Maybe Instrument
   -> EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Instrument)
-> XParse
     (EditorialVoice
      -> Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Instrument -> XParse (Maybe Instrument)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Instrument -> XParse Instrument
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"instrument") (XParse Instrument
parseInstrument))
        XParse
  (EditorialVoice
   -> Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse EditorialVoice
-> XParse
     (Maybe NoteType
      -> [EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EditorialVoice
parseEditorialVoice
        XParse
  (Maybe NoteType
   -> [EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe NoteType)
-> XParse
     ([EmptyPlacement]
      -> Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NoteType -> XParse (Maybe NoteType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NoteType -> XParse NoteType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"type") (XParse NoteType
parseNoteType))
        XParse
  ([EmptyPlacement]
   -> Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse [EmptyPlacement]
-> XParse
     (Maybe Accidental
      -> Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EmptyPlacement -> XParse [EmptyPlacement]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"dot") (XParse EmptyPlacement
parseEmptyPlacement))
        XParse
  (Maybe Accidental
   -> Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Accidental)
-> XParse
     (Maybe TimeModification
      -> Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Accidental -> XParse (Maybe Accidental)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Accidental -> XParse Accidental
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accidental") (XParse Accidental
parseAccidental))
        XParse
  (Maybe TimeModification
   -> Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe TimeModification)
-> XParse
     (Maybe Stem
      -> Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeModification -> XParse (Maybe TimeModification)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TimeModification -> XParse TimeModification
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"time-modification") (XParse TimeModification
parseTimeModification))
        XParse
  (Maybe Stem
   -> Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Stem)
-> XParse
     (Maybe Notehead
      -> Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Stem -> XParse (Maybe Stem)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Stem -> XParse Stem
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stem") (XParse Stem
parseStem))
        XParse
  (Maybe Notehead
   -> Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe Notehead)
-> XParse
     (Maybe NoteheadText
      -> Maybe Staff
      -> [Beam]
      -> [Notations]
      -> [Lyric]
      -> Maybe Play
      -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Notehead -> XParse (Maybe Notehead)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Notehead -> XParse Notehead
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"notehead") (XParse Notehead
parseNotehead))
        XParse
  (Maybe NoteheadText
   -> Maybe Staff
   -> [Beam]
   -> [Notations]
   -> [Lyric]
   -> Maybe Play
   -> Note)
-> XParse (Maybe NoteheadText)
-> XParse
     (Maybe Staff
      -> [Beam] -> [Notations] -> [Lyric] -> Maybe Play -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NoteheadText -> XParse (Maybe NoteheadText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NoteheadText -> XParse NoteheadText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"notehead-text") (XParse NoteheadText
parseNoteheadText))
        XParse
  (Maybe Staff
   -> [Beam] -> [Notations] -> [Lyric] -> Maybe Play -> Note)
-> XParse (Maybe Staff)
-> XParse ([Beam] -> [Notations] -> [Lyric] -> Maybe Play -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Staff -> XParse (Maybe Staff)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Staff
parseStaff)
        XParse ([Beam] -> [Notations] -> [Lyric] -> Maybe Play -> Note)
-> XParse [Beam]
-> XParse ([Notations] -> [Lyric] -> Maybe Play -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Beam -> XParse [Beam]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Beam -> XParse Beam
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beam") (XParse Beam
parseBeam))
        XParse ([Notations] -> [Lyric] -> Maybe Play -> Note)
-> XParse [Notations] -> XParse ([Lyric] -> Maybe Play -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Notations -> XParse [Notations]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Notations -> XParse Notations
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"notations") (XParse Notations
parseNotations))
        XParse ([Lyric] -> Maybe Play -> Note)
-> XParse [Lyric] -> XParse (Maybe Play -> Note)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lyric -> XParse [Lyric]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Lyric -> XParse Lyric
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"lyric") (XParse Lyric
parseLyric))
        XParse (Maybe Play -> Note) -> XParse (Maybe Play) -> XParse Note
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Play -> XParse (Maybe Play)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Play -> XParse Play
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"play") (XParse Play
parsePlay))

-- | Smart constructor for 'Note'
mkNote :: ChxNote -> EditorialVoice -> Note
mkNote :: ChxNote -> EditorialVoice -> Note
mkNote ChxNote
v EditorialVoice
x = Maybe YesNo
-> Maybe NonNegativeDecimal
-> Maybe NonNegativeDecimal
-> Maybe Divisions
-> Maybe Divisions
-> Maybe TimeOnly
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe ID
-> ChxNote
-> Maybe Instrument
-> EditorialVoice
-> Maybe NoteType
-> [EmptyPlacement]
-> Maybe Accidental
-> Maybe TimeModification
-> Maybe Stem
-> Maybe Notehead
-> Maybe NoteheadText
-> Maybe Staff
-> [Beam]
-> [Notations]
-> [Lyric]
-> Maybe Play
-> Note
Note Maybe YesNo
forall a. Maybe a
Nothing Maybe NonNegativeDecimal
forall a. Maybe a
Nothing Maybe NonNegativeDecimal
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe TimeOnly
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxNote
v Maybe Instrument
forall a. Maybe a
Nothing EditorialVoice
x Maybe NoteType
forall a. Maybe a
Nothing [] Maybe Accidental
forall a. Maybe a
Nothing Maybe TimeModification
forall a. Maybe a
Nothing Maybe Stem
forall a. Maybe a
Nothing Maybe Notehead
forall a. Maybe a
Nothing Maybe NoteheadText
forall a. Maybe a
Nothing Maybe Staff
forall a. Maybe a
Nothing [] [] [] Maybe Play
forall a. Maybe a
Nothing

-- | @note-size@ /(complex)/
--
-- The note-size type indicates the percentage of the regular note size to use for notes with a cue and large size as defined in the type element. The grace type is used for notes of cue size that that include a grace element. The cue type is used for all other notes with cue size, whether defined explicitly or implicitly via a cue element. The large type is used for notes of large size. The text content represent the numeric percentage. A value of 100 would be identical to the size of a regular note as defined by the music font.
data NoteSize = 
      NoteSize {
          NoteSize -> NonNegativeDecimal
noteSizeNonNegativeDecimal :: NonNegativeDecimal -- ^ text content
        , NoteSize -> NoteSizeType
noteSizeType :: NoteSizeType -- ^ /type/ attribute
       }
    deriving (NoteSize -> NoteSize -> Bool
(NoteSize -> NoteSize -> Bool)
-> (NoteSize -> NoteSize -> Bool) -> Eq NoteSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteSize -> NoteSize -> Bool
$c/= :: NoteSize -> NoteSize -> Bool
== :: NoteSize -> NoteSize -> Bool
$c== :: NoteSize -> NoteSize -> Bool
Eq,Typeable,(forall x. NoteSize -> Rep NoteSize x)
-> (forall x. Rep NoteSize x -> NoteSize) -> Generic NoteSize
forall x. Rep NoteSize x -> NoteSize
forall x. NoteSize -> Rep NoteSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteSize x -> NoteSize
$cfrom :: forall x. NoteSize -> Rep NoteSize x
Generic,Int -> NoteSize -> ShowS
[NoteSize] -> ShowS
NoteSize -> String
(Int -> NoteSize -> ShowS)
-> (NoteSize -> String) -> ([NoteSize] -> ShowS) -> Show NoteSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteSize] -> ShowS
$cshowList :: [NoteSize] -> ShowS
show :: NoteSize -> String
$cshow :: NoteSize -> String
showsPrec :: Int -> NoteSize -> ShowS
$cshowsPrec :: Int -> NoteSize -> ShowS
Show)
instance EmitXml NoteSize where
    emitXml :: NoteSize -> XmlRep
emitXml (NoteSize NonNegativeDecimal
a NoteSizeType
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeDecimal
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (NoteSizeType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteSizeType
b)])
        []
parseNoteSize :: P.XParse NoteSize
parseNoteSize :: XParse NoteSize
parseNoteSize = 
      NonNegativeDecimal -> NoteSizeType -> NoteSize
NoteSize
        (NonNegativeDecimal -> NoteSizeType -> NoteSize)
-> XParse NonNegativeDecimal -> XParse (NoteSizeType -> NoteSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal)
        XParse (NoteSizeType -> NoteSize)
-> XParse NoteSizeType -> XParse NoteSize
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse NoteSizeType) -> XParse NoteSizeType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteSizeType
parseNoteSizeType)

-- | Smart constructor for 'NoteSize'
mkNoteSize :: NonNegativeDecimal -> NoteSizeType -> NoteSize
mkNoteSize :: NonNegativeDecimal -> NoteSizeType -> NoteSize
mkNoteSize NonNegativeDecimal
a NoteSizeType
b = NonNegativeDecimal -> NoteSizeType -> NoteSize
NoteSize NonNegativeDecimal
a NoteSizeType
b

-- | @note-type@ /(complex)/
--
-- The note-type type indicates the graphic note type. Values range from 1024th to maxima. The size attribute indicates full, cue, grace-cue, or large size. The default is full for regular notes, grace-cue for notes that contain both grace and cue elements, and cue for notes that contain either a cue or a grace element, but not both.
data NoteType = 
      NoteType {
          NoteType -> NoteTypeValue
noteTypeNoteTypeValue :: NoteTypeValue -- ^ text content
        , NoteType -> Maybe SymbolSize
noteTypeSize :: (Maybe SymbolSize) -- ^ /size/ attribute
       }
    deriving (NoteType -> NoteType -> Bool
(NoteType -> NoteType -> Bool)
-> (NoteType -> NoteType -> Bool) -> Eq NoteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteType -> NoteType -> Bool
$c/= :: NoteType -> NoteType -> Bool
== :: NoteType -> NoteType -> Bool
$c== :: NoteType -> NoteType -> Bool
Eq,Typeable,(forall x. NoteType -> Rep NoteType x)
-> (forall x. Rep NoteType x -> NoteType) -> Generic NoteType
forall x. Rep NoteType x -> NoteType
forall x. NoteType -> Rep NoteType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteType x -> NoteType
$cfrom :: forall x. NoteType -> Rep NoteType x
Generic,Int -> NoteType -> ShowS
[NoteType] -> ShowS
NoteType -> String
(Int -> NoteType -> ShowS)
-> (NoteType -> String) -> ([NoteType] -> ShowS) -> Show NoteType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteType] -> ShowS
$cshowList :: [NoteType] -> ShowS
show :: NoteType -> String
$cshow :: NoteType -> String
showsPrec :: Int -> NoteType -> ShowS
$cshowsPrec :: Int -> NoteType -> ShowS
Show)
instance EmitXml NoteType where
    emitXml :: NoteType -> XmlRep
emitXml (NoteType NoteTypeValue
a Maybe SymbolSize
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)
        ([XmlRep -> (SymbolSize -> XmlRep) -> Maybe SymbolSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SymbolSize -> XmlRep) -> SymbolSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SymbolSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SymbolSize
b])
        []
parseNoteType :: P.XParse NoteType
parseNoteType :: XParse NoteType
parseNoteType = 
      NoteTypeValue -> Maybe SymbolSize -> NoteType
NoteType
        (NoteTypeValue -> Maybe SymbolSize -> NoteType)
-> XParse NoteTypeValue -> XParse (Maybe SymbolSize -> NoteType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue)
        XParse (Maybe SymbolSize -> NoteType)
-> XParse (Maybe SymbolSize) -> XParse NoteType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SymbolSize -> XParse (Maybe SymbolSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String -> (String -> XParse SymbolSize) -> XParse SymbolSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SymbolSize
parseSymbolSize)

-- | Smart constructor for 'NoteType'
mkNoteType :: NoteTypeValue -> NoteType
mkNoteType :: NoteTypeValue -> NoteType
mkNoteType NoteTypeValue
a = NoteTypeValue -> Maybe SymbolSize -> NoteType
NoteType NoteTypeValue
a Maybe SymbolSize
forall a. Maybe a
Nothing

-- | @notehead@ /(complex)/
--
-- The notehead type indicates shapes other than the open and closed ovals associated with note durations.
-- 
-- The smufl attribute can be used to specify a particular notehead, allowing application interoperability without requiring every SMuFL glyph to have a MusicXML element equivalent. This attribute can be used either with the "other" value, or to refine a specific notehead value such as "cluster". Noteheads in the SMuFL "Note name noteheads" range (U+E150–U+E1AF) should not use the smufl attribute or the "other" value, but instead use the notehead-text element.
-- 
-- For the enclosed shapes, the default is to be hollow for half notes and longer, and filled otherwise. The filled attribute can be set to change this if needed.
-- 
-- If the parentheses attribute is set to yes, the notehead is parenthesized. It is no by default.
data Notehead = 
      Notehead {
          Notehead -> NoteheadValue
noteheadNoteheadValue :: NoteheadValue -- ^ text content
        , Notehead -> Maybe YesNo
noteheadFilled :: (Maybe YesNo) -- ^ /filled/ attribute
        , Notehead -> Maybe YesNo
noteheadParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , Notehead -> Maybe CommaSeparatedText
noteheadFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Notehead -> Maybe FontStyle
noteheadFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Notehead -> Maybe FontSize
noteheadFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Notehead -> Maybe FontWeight
noteheadFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Notehead -> Maybe Color
noteheadColor :: (Maybe Color) -- ^ /color/ attribute
        , Notehead -> Maybe SmuflGlyphName
noteheadSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
       }
    deriving (Notehead -> Notehead -> Bool
(Notehead -> Notehead -> Bool)
-> (Notehead -> Notehead -> Bool) -> Eq Notehead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notehead -> Notehead -> Bool
$c/= :: Notehead -> Notehead -> Bool
== :: Notehead -> Notehead -> Bool
$c== :: Notehead -> Notehead -> Bool
Eq,Typeable,(forall x. Notehead -> Rep Notehead x)
-> (forall x. Rep Notehead x -> Notehead) -> Generic Notehead
forall x. Rep Notehead x -> Notehead
forall x. Notehead -> Rep Notehead x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Notehead x -> Notehead
$cfrom :: forall x. Notehead -> Rep Notehead x
Generic,Int -> Notehead -> ShowS
[Notehead] -> ShowS
Notehead -> String
(Int -> Notehead -> ShowS)
-> (Notehead -> String) -> ([Notehead] -> ShowS) -> Show Notehead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notehead] -> ShowS
$cshowList :: [Notehead] -> ShowS
show :: Notehead -> String
$cshow :: Notehead -> String
showsPrec :: Int -> Notehead -> ShowS
$cshowsPrec :: Int -> Notehead -> ShowS
Show)
instance EmitXml Notehead where
    emitXml :: Notehead -> XmlRep
emitXml (Notehead NoteheadValue
a Maybe YesNo
b Maybe YesNo
c Maybe CommaSeparatedText
d Maybe FontStyle
e Maybe FontSize
f Maybe FontWeight
g Maybe Color
h Maybe SmuflGlyphName
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NoteheadValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteheadValue
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"filled" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
i])
        []
parseNotehead :: P.XParse Notehead
parseNotehead :: XParse Notehead
parseNotehead = 
      NoteheadValue
-> Maybe YesNo
-> Maybe YesNo
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe SmuflGlyphName
-> Notehead
Notehead
        (NoteheadValue
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe SmuflGlyphName
 -> Notehead)
-> XParse NoteheadValue
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe SmuflGlyphName
      -> Notehead)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NoteheadValue) -> XParse NoteheadValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteheadValue
parseNoteheadValue)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe SmuflGlyphName
   -> Notehead)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe SmuflGlyphName
      -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"filled") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe SmuflGlyphName
   -> Notehead)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe SmuflGlyphName
      -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe SmuflGlyphName
   -> Notehead)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe SmuflGlyphName
      -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe SmuflGlyphName
   -> Notehead)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe SmuflGlyphName
      -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe SmuflGlyphName
   -> Notehead)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe SmuflGlyphName -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe SmuflGlyphName -> Notehead)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe SmuflGlyphName -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe SmuflGlyphName -> Notehead)
-> XParse (Maybe Color)
-> XParse (Maybe SmuflGlyphName -> Notehead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe SmuflGlyphName -> Notehead)
-> XParse (Maybe SmuflGlyphName) -> XParse Notehead
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)

-- | Smart constructor for 'Notehead'
mkNotehead :: NoteheadValue -> Notehead
mkNotehead :: NoteheadValue -> Notehead
mkNotehead NoteheadValue
a = NoteheadValue
-> Maybe YesNo
-> Maybe YesNo
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe SmuflGlyphName
-> Notehead
Notehead NoteheadValue
a Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing

-- | @notehead-text@ /(complex)/
--
-- The notehead-text type represents text that is displayed inside a notehead, as is done in some educational music. It is not needed for the numbers used in tablature or jianpu notation. The presence of a TAB or jianpu clefs is sufficient to indicate that numbers are used. The display-text and accidental-text elements allow display of fully formatted text and accidentals.
data NoteheadText = 
      NoteheadText {
          NoteheadText -> [ChxNoteheadText]
noteheadTextNoteheadText :: [ChxNoteheadText]
       }
    deriving (NoteheadText -> NoteheadText -> Bool
(NoteheadText -> NoteheadText -> Bool)
-> (NoteheadText -> NoteheadText -> Bool) -> Eq NoteheadText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteheadText -> NoteheadText -> Bool
$c/= :: NoteheadText -> NoteheadText -> Bool
== :: NoteheadText -> NoteheadText -> Bool
$c== :: NoteheadText -> NoteheadText -> Bool
Eq,Typeable,(forall x. NoteheadText -> Rep NoteheadText x)
-> (forall x. Rep NoteheadText x -> NoteheadText)
-> Generic NoteheadText
forall x. Rep NoteheadText x -> NoteheadText
forall x. NoteheadText -> Rep NoteheadText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NoteheadText x -> NoteheadText
$cfrom :: forall x. NoteheadText -> Rep NoteheadText x
Generic,Int -> NoteheadText -> ShowS
[NoteheadText] -> ShowS
NoteheadText -> String
(Int -> NoteheadText -> ShowS)
-> (NoteheadText -> String)
-> ([NoteheadText] -> ShowS)
-> Show NoteheadText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteheadText] -> ShowS
$cshowList :: [NoteheadText] -> ShowS
show :: NoteheadText -> String
$cshow :: NoteheadText -> String
showsPrec :: Int -> NoteheadText -> ShowS
$cshowsPrec :: Int -> NoteheadText -> ShowS
Show)
instance EmitXml NoteheadText where
    emitXml :: NoteheadText -> XmlRep
emitXml (NoteheadText [ChxNoteheadText]
a) =
      [XmlRep] -> XmlRep
XReps [[ChxNoteheadText] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxNoteheadText]
a]
parseNoteheadText :: P.XParse NoteheadText
parseNoteheadText :: XParse NoteheadText
parseNoteheadText = 
      [ChxNoteheadText] -> NoteheadText
NoteheadText
        ([ChxNoteheadText] -> NoteheadText)
-> XParse [ChxNoteheadText] -> XParse NoteheadText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxNoteheadText -> XParse [ChxNoteheadText]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxNoteheadText
parseChxNoteheadText)

-- | Smart constructor for 'NoteheadText'
mkNoteheadText :: NoteheadText
mkNoteheadText :: NoteheadText
mkNoteheadText = [ChxNoteheadText] -> NoteheadText
NoteheadText []

-- | @octave-shift@ /(complex)/
--
-- The octave shift type indicates where notes are shifted up or down from their true pitched values because of printing difficulty. Thus a treble clef line noted with 8va will be indicated with an octave-shift down from the pitch data indicated in the notes. A size of 8 indicates one octave; a size of 15 indicates two octaves.
data OctaveShift = 
      OctaveShift {
          OctaveShift -> UpDownStopContinue
octaveShiftType :: UpDownStopContinue -- ^ /type/ attribute
        , OctaveShift -> Maybe NumberLevel
octaveShiftNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , OctaveShift -> Maybe PositiveInteger
octaveShiftSize :: (Maybe PositiveInteger) -- ^ /size/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , OctaveShift -> Maybe Tenths
octaveShiftRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , OctaveShift -> Maybe CommaSeparatedText
octaveShiftFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , OctaveShift -> Maybe FontStyle
octaveShiftFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , OctaveShift -> Maybe FontSize
octaveShiftFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , OctaveShift -> Maybe FontWeight
octaveShiftFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , OctaveShift -> Maybe Color
octaveShiftColor :: (Maybe Color) -- ^ /color/ attribute
        , OctaveShift -> Maybe ID
octaveShiftId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (OctaveShift -> OctaveShift -> Bool
(OctaveShift -> OctaveShift -> Bool)
-> (OctaveShift -> OctaveShift -> Bool) -> Eq OctaveShift
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OctaveShift -> OctaveShift -> Bool
$c/= :: OctaveShift -> OctaveShift -> Bool
== :: OctaveShift -> OctaveShift -> Bool
$c== :: OctaveShift -> OctaveShift -> Bool
Eq,Typeable,(forall x. OctaveShift -> Rep OctaveShift x)
-> (forall x. Rep OctaveShift x -> OctaveShift)
-> Generic OctaveShift
forall x. Rep OctaveShift x -> OctaveShift
forall x. OctaveShift -> Rep OctaveShift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OctaveShift x -> OctaveShift
$cfrom :: forall x. OctaveShift -> Rep OctaveShift x
Generic,Int -> OctaveShift -> ShowS
[OctaveShift] -> ShowS
OctaveShift -> String
(Int -> OctaveShift -> ShowS)
-> (OctaveShift -> String)
-> ([OctaveShift] -> ShowS)
-> Show OctaveShift
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OctaveShift] -> ShowS
$cshowList :: [OctaveShift] -> ShowS
show :: OctaveShift -> String
$cshow :: OctaveShift -> String
showsPrec :: Int -> OctaveShift -> ShowS
$cshowsPrec :: Int -> OctaveShift -> ShowS
Show)
instance EmitXml OctaveShift where
    emitXml :: OctaveShift -> XmlRep
emitXml (OctaveShift UpDownStopContinue
a Maybe NumberLevel
b Maybe PositiveInteger
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe CommaSeparatedText
j Maybe FontStyle
k Maybe FontSize
l Maybe FontWeight
m Maybe Color
n Maybe ID
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (UpDownStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml UpDownStopContinue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
o])
        []
parseOctaveShift :: P.XParse OctaveShift
parseOctaveShift :: XParse OctaveShift
parseOctaveShift = 
      UpDownStopContinue
-> Maybe NumberLevel
-> Maybe PositiveInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> OctaveShift
OctaveShift
        (UpDownStopContinue
 -> Maybe NumberLevel
 -> Maybe PositiveInteger
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe ID
 -> OctaveShift)
-> XParse UpDownStopContinue
-> XParse
     (Maybe NumberLevel
      -> Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse UpDownStopContinue)
-> XParse UpDownStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse UpDownStopContinue
parseUpDownStopContinue)
        XParse
  (Maybe NumberLevel
   -> Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe PositiveInteger
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe PositiveInteger
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe PositiveInteger)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"size") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe ID
      -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe ID
   -> OctaveShift)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe ID -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe ID -> OctaveShift)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe ID -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Maybe ID -> OctaveShift)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe ID -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe ID -> OctaveShift)
-> XParse (Maybe Color) -> XParse (Maybe ID -> OctaveShift)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> OctaveShift)
-> XParse (Maybe ID) -> XParse OctaveShift
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'OctaveShift'
mkOctaveShift :: UpDownStopContinue -> OctaveShift
mkOctaveShift :: UpDownStopContinue -> OctaveShift
mkOctaveShift UpDownStopContinue
a = UpDownStopContinue
-> Maybe NumberLevel
-> Maybe PositiveInteger
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe ID
-> OctaveShift
OctaveShift UpDownStopContinue
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe PositiveInteger
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @offset@ /(complex)/
--
-- An offset is represented in terms of divisions, and indicates where the direction will appear relative to the current musical location. This affects the visual appearance of the direction. If the sound attribute is "yes", then the offset affects playback too. If the sound attribute is "no", then any sound associated with the direction takes effect at the current location. The sound attribute is "no" by default for compatibility with earlier versions of the MusicXML format. If an element within a direction includes a default-x attribute, the offset value will be ignored when determining the appearance of that element.
data Offset = 
      Offset {
          Offset -> Divisions
offsetDivisions :: Divisions -- ^ text content
        , Offset -> Maybe YesNo
offsetSound :: (Maybe YesNo) -- ^ /sound/ attribute
       }
    deriving (Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq,Typeable,(forall x. Offset -> Rep Offset x)
-> (forall x. Rep Offset x -> Offset) -> Generic Offset
forall x. Rep Offset x -> Offset
forall x. Offset -> Rep Offset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Offset x -> Offset
$cfrom :: forall x. Offset -> Rep Offset x
Generic,Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show)
instance EmitXml Offset where
    emitXml :: Offset -> XmlRep
emitXml (Offset Divisions
a Maybe YesNo
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Divisions
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"sound" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b])
        []
parseOffset :: P.XParse Offset
parseOffset :: XParse Offset
parseOffset = 
      Divisions -> Maybe YesNo -> Offset
Offset
        (Divisions -> Maybe YesNo -> Offset)
-> XParse Divisions -> XParse (Maybe YesNo -> Offset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe YesNo -> Offset)
-> XParse (Maybe YesNo) -> XParse Offset
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"sound") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)

-- | Smart constructor for 'Offset'
mkOffset :: Divisions -> Offset
mkOffset :: Divisions -> Offset
mkOffset Divisions
a = Divisions -> Maybe YesNo -> Offset
Offset Divisions
a Maybe YesNo
forall a. Maybe a
Nothing

-- | @opus@ /(complex)/
--
-- The opus type represents a link to a MusicXML opus document that composes multiple MusicXML scores into a collection.
data Opus = 
      Opus {
          Opus -> String
opusHref :: String -- ^ /xlink:href/ attribute
        , Opus -> Maybe Type
opusType :: (Maybe Type) -- ^ /xlink:type/ attribute
        , Opus -> Maybe Token
opusRole :: (Maybe Token) -- ^ /xlink:role/ attribute
        , Opus -> Maybe Token
opusTitle :: (Maybe Token) -- ^ /xlink:title/ attribute
        , Opus -> Maybe SmpShow
opusShow :: (Maybe SmpShow) -- ^ /xlink:show/ attribute
        , Opus -> Maybe Actuate
opusActuate :: (Maybe Actuate) -- ^ /xlink:actuate/ attribute
       }
    deriving (Opus -> Opus -> Bool
(Opus -> Opus -> Bool) -> (Opus -> Opus -> Bool) -> Eq Opus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Opus -> Opus -> Bool
$c/= :: Opus -> Opus -> Bool
== :: Opus -> Opus -> Bool
$c== :: Opus -> Opus -> Bool
Eq,Typeable,(forall x. Opus -> Rep Opus x)
-> (forall x. Rep Opus x -> Opus) -> Generic Opus
forall x. Rep Opus x -> Opus
forall x. Opus -> Rep Opus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Opus x -> Opus
$cfrom :: forall x. Opus -> Rep Opus x
Generic,Int -> Opus -> ShowS
[Opus] -> ShowS
Opus -> String
(Int -> Opus -> ShowS)
-> (Opus -> String) -> ([Opus] -> ShowS) -> Show Opus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Opus] -> ShowS
$cshowList :: [Opus] -> ShowS
show :: Opus -> String
$cshow :: Opus -> String
showsPrec :: Int -> Opus -> ShowS
$cshowsPrec :: Int -> Opus -> ShowS
Show)
instance EmitXml Opus where
    emitXml :: Opus -> XmlRep
emitXml (Opus String
a Maybe Type
b Maybe Token
c Maybe Token
d Maybe SmpShow
e Maybe Actuate
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"href" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink")) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Type -> XmlRep) -> Maybe Type -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Type -> XmlRep) -> Type -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Type -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Type
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"role" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"title" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SmpShow -> XmlRep) -> Maybe SmpShow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (SmpShow -> XmlRep) -> SmpShow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmpShow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmpShow
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Actuate -> XmlRep) -> Maybe Actuate -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"actuate" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xlink"))(XmlRep -> XmlRep) -> (Actuate -> XmlRep) -> Actuate -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Actuate -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Actuate
f])
        []
parseOpus :: P.XParse Opus
parseOpus :: XParse Opus
parseOpus = 
      String
-> Maybe Type
-> Maybe Token
-> Maybe Token
-> Maybe SmpShow
-> Maybe Actuate
-> Opus
Opus
        (String
 -> Maybe Type
 -> Maybe Token
 -> Maybe Token
 -> Maybe SmpShow
 -> Maybe Actuate
 -> Opus)
-> XParse String
-> XParse
     (Maybe Type
      -> Maybe Token
      -> Maybe Token
      -> Maybe SmpShow
      -> Maybe Actuate
      -> Opus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:href") XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Type
   -> Maybe Token
   -> Maybe Token
   -> Maybe SmpShow
   -> Maybe Actuate
   -> Opus)
-> XParse (Maybe Type)
-> XParse
     (Maybe Token
      -> Maybe Token -> Maybe SmpShow -> Maybe Actuate -> Opus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Type -> XParse (Maybe Type)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:type") XParse String -> (String -> XParse Type) -> XParse Type
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Type
parseType)
        XParse
  (Maybe Token
   -> Maybe Token -> Maybe SmpShow -> Maybe Actuate -> Opus)
-> XParse (Maybe Token)
-> XParse (Maybe Token -> Maybe SmpShow -> Maybe Actuate -> Opus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:role") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe Token -> Maybe SmpShow -> Maybe Actuate -> Opus)
-> XParse (Maybe Token)
-> XParse (Maybe SmpShow -> Maybe Actuate -> Opus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:title") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (Maybe SmpShow -> Maybe Actuate -> Opus)
-> XParse (Maybe SmpShow) -> XParse (Maybe Actuate -> Opus)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmpShow -> XParse (Maybe SmpShow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:show") XParse String -> (String -> XParse SmpShow) -> XParse SmpShow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmpShow
parseSmpShow)
        XParse (Maybe Actuate -> Opus)
-> XParse (Maybe Actuate) -> XParse Opus
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Actuate -> XParse (Maybe Actuate)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xlink:actuate") XParse String -> (String -> XParse Actuate) -> XParse Actuate
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Actuate
parseActuate)

-- | Smart constructor for 'Opus'
mkOpus :: String -> Opus
mkOpus :: String -> Opus
mkOpus String
a = String
-> Maybe Type
-> Maybe Token
-> Maybe Token
-> Maybe SmpShow
-> Maybe Actuate
-> Opus
Opus String
a Maybe Type
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe SmpShow
forall a. Maybe a
Nothing Maybe Actuate
forall a. Maybe a
Nothing

-- | @ornaments@ /(complex)/
--
-- Ornaments can be any of several types, followed optionally by accidentals. The accidental-mark element's content is represented the same as an accidental element, but with a different name to reflect the different musical meaning.
data Ornaments = 
      Ornaments {
          Ornaments -> Maybe ID
ornamentsId :: (Maybe ID) -- ^ /id/ attribute
        , Ornaments -> [SeqOrnaments]
ornamentsOrnaments :: [SeqOrnaments]
       }
    deriving (Ornaments -> Ornaments -> Bool
(Ornaments -> Ornaments -> Bool)
-> (Ornaments -> Ornaments -> Bool) -> Eq Ornaments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ornaments -> Ornaments -> Bool
$c/= :: Ornaments -> Ornaments -> Bool
== :: Ornaments -> Ornaments -> Bool
$c== :: Ornaments -> Ornaments -> Bool
Eq,Typeable,(forall x. Ornaments -> Rep Ornaments x)
-> (forall x. Rep Ornaments x -> Ornaments) -> Generic Ornaments
forall x. Rep Ornaments x -> Ornaments
forall x. Ornaments -> Rep Ornaments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ornaments x -> Ornaments
$cfrom :: forall x. Ornaments -> Rep Ornaments x
Generic,Int -> Ornaments -> ShowS
[Ornaments] -> ShowS
Ornaments -> String
(Int -> Ornaments -> ShowS)
-> (Ornaments -> String)
-> ([Ornaments] -> ShowS)
-> Show Ornaments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ornaments] -> ShowS
$cshowList :: [Ornaments] -> ShowS
show :: Ornaments -> String
$cshow :: Ornaments -> String
showsPrec :: Int -> Ornaments -> ShowS
$cshowsPrec :: Int -> Ornaments -> ShowS
Show)
instance EmitXml Ornaments where
    emitXml :: Ornaments -> XmlRep
emitXml (Ornaments Maybe ID
a [SeqOrnaments]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
a])
        ([[SeqOrnaments] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [SeqOrnaments]
b])
parseOrnaments :: P.XParse Ornaments
parseOrnaments :: XParse Ornaments
parseOrnaments = 
      Maybe ID -> [SeqOrnaments] -> Ornaments
Ornaments
        (Maybe ID -> [SeqOrnaments] -> Ornaments)
-> XParse (Maybe ID) -> XParse ([SeqOrnaments] -> Ornaments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([SeqOrnaments] -> Ornaments)
-> XParse [SeqOrnaments] -> XParse Ornaments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqOrnaments -> XParse [SeqOrnaments]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse SeqOrnaments
parseSeqOrnaments)

-- | Smart constructor for 'Ornaments'
mkOrnaments :: Ornaments
mkOrnaments :: Ornaments
mkOrnaments = Maybe ID -> [SeqOrnaments] -> Ornaments
Ornaments Maybe ID
forall a. Maybe a
Nothing []

-- | @other-appearance@ /(complex)/
--
-- The other-appearance type is used to define any graphical settings not yet in the current version of the MusicXML format. This allows extended representation, though without application interoperability.
data OtherAppearance = 
      OtherAppearance {
          OtherAppearance -> String
otherAppearanceString :: String -- ^ text content
        , OtherAppearance -> Token
otherAppearanceType :: Token -- ^ /type/ attribute
       }
    deriving (OtherAppearance -> OtherAppearance -> Bool
(OtherAppearance -> OtherAppearance -> Bool)
-> (OtherAppearance -> OtherAppearance -> Bool)
-> Eq OtherAppearance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherAppearance -> OtherAppearance -> Bool
$c/= :: OtherAppearance -> OtherAppearance -> Bool
== :: OtherAppearance -> OtherAppearance -> Bool
$c== :: OtherAppearance -> OtherAppearance -> Bool
Eq,Typeable,(forall x. OtherAppearance -> Rep OtherAppearance x)
-> (forall x. Rep OtherAppearance x -> OtherAppearance)
-> Generic OtherAppearance
forall x. Rep OtherAppearance x -> OtherAppearance
forall x. OtherAppearance -> Rep OtherAppearance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherAppearance x -> OtherAppearance
$cfrom :: forall x. OtherAppearance -> Rep OtherAppearance x
Generic,Int -> OtherAppearance -> ShowS
[OtherAppearance] -> ShowS
OtherAppearance -> String
(Int -> OtherAppearance -> ShowS)
-> (OtherAppearance -> String)
-> ([OtherAppearance] -> ShowS)
-> Show OtherAppearance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherAppearance] -> ShowS
$cshowList :: [OtherAppearance] -> ShowS
show :: OtherAppearance -> String
$cshow :: OtherAppearance -> String
showsPrec :: Int -> OtherAppearance -> ShowS
$cshowsPrec :: Int -> OtherAppearance -> ShowS
Show)
instance EmitXml OtherAppearance where
    emitXml :: OtherAppearance -> XmlRep
emitXml (OtherAppearance String
a Token
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
b)])
        []
parseOtherAppearance :: P.XParse OtherAppearance
parseOtherAppearance :: XParse OtherAppearance
parseOtherAppearance = 
      String -> Token -> OtherAppearance
OtherAppearance
        (String -> Token -> OtherAppearance)
-> XParse String -> XParse (Token -> OtherAppearance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Token -> OtherAppearance)
-> XParse Token -> XParse OtherAppearance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'OtherAppearance'
mkOtherAppearance :: String -> Token -> OtherAppearance
mkOtherAppearance :: String -> Token -> OtherAppearance
mkOtherAppearance String
a Token
b = String -> Token -> OtherAppearance
OtherAppearance String
a Token
b

-- | @other-direction@ /(complex)/
--
-- The other-direction type is used to define any direction symbols not yet in the MusicXML format. The smufl attribute can be used to specify a particular direction symbol, allowing application interoperability without requiring every SMuFL glyph to have a MusicXML element equivalent. Using the other-direction type without the smufl attribute allows for extended representation, though without application interoperability.
data OtherDirection = 
      OtherDirection {
          OtherDirection -> String
otherDirectionString :: String -- ^ text content
        , OtherDirection -> Maybe YesNo
otherDirectionPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , OtherDirection -> Maybe Tenths
otherDirectionDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , OtherDirection -> Maybe Tenths
otherDirectionDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , OtherDirection -> Maybe Tenths
otherDirectionRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , OtherDirection -> Maybe Tenths
otherDirectionRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , OtherDirection -> Maybe CommaSeparatedText
otherDirectionFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , OtherDirection -> Maybe FontStyle
otherDirectionFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , OtherDirection -> Maybe FontSize
otherDirectionFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , OtherDirection -> Maybe FontWeight
otherDirectionFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , OtherDirection -> Maybe Color
otherDirectionColor :: (Maybe Color) -- ^ /color/ attribute
        , OtherDirection -> Maybe LeftCenterRight
otherDirectionHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , OtherDirection -> Maybe Valign
otherDirectionValign :: (Maybe Valign) -- ^ /valign/ attribute
        , OtherDirection -> Maybe SmuflGlyphName
otherDirectionSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
        , OtherDirection -> Maybe ID
otherDirectionId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (OtherDirection -> OtherDirection -> Bool
(OtherDirection -> OtherDirection -> Bool)
-> (OtherDirection -> OtherDirection -> Bool) -> Eq OtherDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherDirection -> OtherDirection -> Bool
$c/= :: OtherDirection -> OtherDirection -> Bool
== :: OtherDirection -> OtherDirection -> Bool
$c== :: OtherDirection -> OtherDirection -> Bool
Eq,Typeable,(forall x. OtherDirection -> Rep OtherDirection x)
-> (forall x. Rep OtherDirection x -> OtherDirection)
-> Generic OtherDirection
forall x. Rep OtherDirection x -> OtherDirection
forall x. OtherDirection -> Rep OtherDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherDirection x -> OtherDirection
$cfrom :: forall x. OtherDirection -> Rep OtherDirection x
Generic,Int -> OtherDirection -> ShowS
[OtherDirection] -> ShowS
OtherDirection -> String
(Int -> OtherDirection -> ShowS)
-> (OtherDirection -> String)
-> ([OtherDirection] -> ShowS)
-> Show OtherDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherDirection] -> ShowS
$cshowList :: [OtherDirection] -> ShowS
show :: OtherDirection -> String
$cshow :: OtherDirection -> String
showsPrec :: Int -> OtherDirection -> ShowS
$cshowsPrec :: Int -> OtherDirection -> ShowS
Show)
instance EmitXml OtherDirection where
    emitXml :: OtherDirection -> XmlRep
emitXml (OtherDirection String
a Maybe YesNo
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k Maybe LeftCenterRight
l Maybe Valign
m Maybe SmuflGlyphName
n Maybe ID
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
o])
        []
parseOtherDirection :: P.XParse OtherDirection
parseOtherDirection :: XParse OtherDirection
parseOtherDirection = 
      String
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe SmuflGlyphName
-> Maybe ID
-> OtherDirection
OtherDirection
        (String
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe SmuflGlyphName
 -> Maybe ID
 -> OtherDirection)
-> XParse String
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherDirection)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe SmuflGlyphName -> Maybe ID -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe SmuflGlyphName -> Maybe ID -> OtherDirection)
-> XParse (Maybe Valign)
-> XParse (Maybe SmuflGlyphName -> Maybe ID -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe SmuflGlyphName -> Maybe ID -> OtherDirection)
-> XParse (Maybe SmuflGlyphName)
-> XParse (Maybe ID -> OtherDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)
        XParse (Maybe ID -> OtherDirection)
-> XParse (Maybe ID) -> XParse OtherDirection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'OtherDirection'
mkOtherDirection :: String -> OtherDirection
mkOtherDirection :: String -> OtherDirection
mkOtherDirection String
a = String
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe SmuflGlyphName
-> Maybe ID
-> OtherDirection
OtherDirection String
a Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @other-notation@ /(complex)/
--
-- The other-notation type is used to define any notations not yet in the MusicXML format. It handles notations where more specific extension elements such as other-dynamics and other-technical are not appropriate. The smufl attribute can be used to specify a particular notation, allowing application interoperability without requiring every SMuFL glyph to have a MusicXML element equivalent. Using the other-notation type without the smufl attribute allows for extended representation, though without application interoperability.
data OtherNotation = 
      OtherNotation {
          OtherNotation -> String
otherNotationString :: String -- ^ text content
        , OtherNotation -> StartStopSingle
otherNotationType :: StartStopSingle -- ^ /type/ attribute
        , OtherNotation -> Maybe NumberLevel
otherNotationNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , OtherNotation -> Maybe YesNo
otherNotationPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , OtherNotation -> Maybe Tenths
otherNotationDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , OtherNotation -> Maybe Tenths
otherNotationDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , OtherNotation -> Maybe Tenths
otherNotationRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , OtherNotation -> Maybe Tenths
otherNotationRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , OtherNotation -> Maybe CommaSeparatedText
otherNotationFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , OtherNotation -> Maybe FontStyle
otherNotationFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , OtherNotation -> Maybe FontSize
otherNotationFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , OtherNotation -> Maybe FontWeight
otherNotationFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , OtherNotation -> Maybe Color
otherNotationColor :: (Maybe Color) -- ^ /color/ attribute
        , OtherNotation -> Maybe AboveBelow
otherNotationPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , OtherNotation -> Maybe SmuflGlyphName
otherNotationSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
        , OtherNotation -> Maybe ID
otherNotationId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (OtherNotation -> OtherNotation -> Bool
(OtherNotation -> OtherNotation -> Bool)
-> (OtherNotation -> OtherNotation -> Bool) -> Eq OtherNotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherNotation -> OtherNotation -> Bool
$c/= :: OtherNotation -> OtherNotation -> Bool
== :: OtherNotation -> OtherNotation -> Bool
$c== :: OtherNotation -> OtherNotation -> Bool
Eq,Typeable,(forall x. OtherNotation -> Rep OtherNotation x)
-> (forall x. Rep OtherNotation x -> OtherNotation)
-> Generic OtherNotation
forall x. Rep OtherNotation x -> OtherNotation
forall x. OtherNotation -> Rep OtherNotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherNotation x -> OtherNotation
$cfrom :: forall x. OtherNotation -> Rep OtherNotation x
Generic,Int -> OtherNotation -> ShowS
[OtherNotation] -> ShowS
OtherNotation -> String
(Int -> OtherNotation -> ShowS)
-> (OtherNotation -> String)
-> ([OtherNotation] -> ShowS)
-> Show OtherNotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherNotation] -> ShowS
$cshowList :: [OtherNotation] -> ShowS
show :: OtherNotation -> String
$cshow :: OtherNotation -> String
showsPrec :: Int -> OtherNotation -> ShowS
$cshowsPrec :: Int -> OtherNotation -> ShowS
Show)
instance EmitXml OtherNotation where
    emitXml :: OtherNotation -> XmlRep
emitXml (OtherNotation String
a StartStopSingle
b Maybe NumberLevel
c Maybe YesNo
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe CommaSeparatedText
i Maybe FontStyle
j Maybe FontSize
k Maybe FontWeight
l Maybe Color
m Maybe AboveBelow
n Maybe SmuflGlyphName
o Maybe ID
p) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopSingle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopSingle
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
p])
        []
parseOtherNotation :: P.XParse OtherNotation
parseOtherNotation :: XParse OtherNotation
parseOtherNotation = 
      String
-> StartStopSingle
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> Maybe ID
-> OtherNotation
OtherNotation
        (String
 -> StartStopSingle
 -> Maybe NumberLevel
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe SmuflGlyphName
 -> Maybe ID
 -> OtherNotation)
-> XParse String
-> XParse
     (StartStopSingle
      -> Maybe NumberLevel
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (StartStopSingle
   -> Maybe NumberLevel
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse StartStopSingle
-> XParse
     (Maybe NumberLevel
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopSingle) -> XParse StartStopSingle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopSingle
parseStartStopSingle)
        XParse
  (Maybe NumberLevel
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Maybe ID
      -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Maybe ID
   -> OtherNotation)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow
      -> Maybe SmuflGlyphName -> Maybe ID -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow
   -> Maybe SmuflGlyphName -> Maybe ID -> OtherNotation)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe SmuflGlyphName -> Maybe ID -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe SmuflGlyphName -> Maybe ID -> OtherNotation)
-> XParse (Maybe SmuflGlyphName)
-> XParse (Maybe ID -> OtherNotation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)
        XParse (Maybe ID -> OtherNotation)
-> XParse (Maybe ID) -> XParse OtherNotation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'OtherNotation'
mkOtherNotation :: String -> StartStopSingle -> OtherNotation
mkOtherNotation :: String -> StartStopSingle -> OtherNotation
mkOtherNotation String
a StartStopSingle
b = String
-> StartStopSingle
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> Maybe ID
-> OtherNotation
OtherNotation String
a StartStopSingle
b Maybe NumberLevel
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @other-placement-text@ /(complex)/
--
-- The other-placement-text type represents a text element with print-style, placement, and smufl attribute groups. This type is used by MusicXML notation extension elements to allow specification of specific SMuFL glyphs without needed to add every glyph as a MusicXML element.
data OtherPlacementText = 
      OtherPlacementText {
          OtherPlacementText -> String
otherPlacementTextString :: String -- ^ text content
        , OtherPlacementText -> Maybe Tenths
otherPlacementTextDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , OtherPlacementText -> Maybe Tenths
otherPlacementTextDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , OtherPlacementText -> Maybe Tenths
otherPlacementTextRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , OtherPlacementText -> Maybe Tenths
otherPlacementTextRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , OtherPlacementText -> Maybe CommaSeparatedText
otherPlacementTextFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , OtherPlacementText -> Maybe FontStyle
otherPlacementTextFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , OtherPlacementText -> Maybe FontSize
otherPlacementTextFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , OtherPlacementText -> Maybe FontWeight
otherPlacementTextFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , OtherPlacementText -> Maybe Color
otherPlacementTextColor :: (Maybe Color) -- ^ /color/ attribute
        , OtherPlacementText -> Maybe AboveBelow
otherPlacementTextPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , OtherPlacementText -> Maybe SmuflGlyphName
otherPlacementTextSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
       }
    deriving (OtherPlacementText -> OtherPlacementText -> Bool
(OtherPlacementText -> OtherPlacementText -> Bool)
-> (OtherPlacementText -> OtherPlacementText -> Bool)
-> Eq OtherPlacementText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherPlacementText -> OtherPlacementText -> Bool
$c/= :: OtherPlacementText -> OtherPlacementText -> Bool
== :: OtherPlacementText -> OtherPlacementText -> Bool
$c== :: OtherPlacementText -> OtherPlacementText -> Bool
Eq,Typeable,(forall x. OtherPlacementText -> Rep OtherPlacementText x)
-> (forall x. Rep OtherPlacementText x -> OtherPlacementText)
-> Generic OtherPlacementText
forall x. Rep OtherPlacementText x -> OtherPlacementText
forall x. OtherPlacementText -> Rep OtherPlacementText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherPlacementText x -> OtherPlacementText
$cfrom :: forall x. OtherPlacementText -> Rep OtherPlacementText x
Generic,Int -> OtherPlacementText -> ShowS
[OtherPlacementText] -> ShowS
OtherPlacementText -> String
(Int -> OtherPlacementText -> ShowS)
-> (OtherPlacementText -> String)
-> ([OtherPlacementText] -> ShowS)
-> Show OtherPlacementText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherPlacementText] -> ShowS
$cshowList :: [OtherPlacementText] -> ShowS
show :: OtherPlacementText -> String
$cshow :: OtherPlacementText -> String
showsPrec :: Int -> OtherPlacementText -> ShowS
$cshowsPrec :: Int -> OtherPlacementText -> ShowS
Show)
instance EmitXml OtherPlacementText where
    emitXml :: OtherPlacementText -> XmlRep
emitXml (OtherPlacementText String
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k Maybe SmuflGlyphName
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
l])
        []
parseOtherPlacementText :: P.XParse OtherPlacementText
parseOtherPlacementText :: XParse OtherPlacementText
parseOtherPlacementText = 
      String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> OtherPlacementText
OtherPlacementText
        (String
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe SmuflGlyphName
 -> OtherPlacementText)
-> XParse String
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> OtherPlacementText)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow -> Maybe SmuflGlyphName -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow -> Maybe SmuflGlyphName -> OtherPlacementText)
-> XParse (Maybe Color)
-> XParse
     (Maybe AboveBelow -> Maybe SmuflGlyphName -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe AboveBelow -> Maybe SmuflGlyphName -> OtherPlacementText)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe SmuflGlyphName -> OtherPlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe SmuflGlyphName -> OtherPlacementText)
-> XParse (Maybe SmuflGlyphName) -> XParse OtherPlacementText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)

-- | Smart constructor for 'OtherPlacementText'
mkOtherPlacementText :: String -> OtherPlacementText
mkOtherPlacementText :: String -> OtherPlacementText
mkOtherPlacementText String
a = String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> OtherPlacementText
OtherPlacementText String
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing

-- | @other-play@ /(complex)/
--
-- The other-play element represents other types of playback. The required type attribute indicates the type of playback to which the element content applies.
data OtherPlay = 
      OtherPlay {
          OtherPlay -> String
otherPlayString :: String -- ^ text content
        , OtherPlay -> Token
otherPlayType :: Token -- ^ /type/ attribute
       }
    deriving (OtherPlay -> OtherPlay -> Bool
(OtherPlay -> OtherPlay -> Bool)
-> (OtherPlay -> OtherPlay -> Bool) -> Eq OtherPlay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherPlay -> OtherPlay -> Bool
$c/= :: OtherPlay -> OtherPlay -> Bool
== :: OtherPlay -> OtherPlay -> Bool
$c== :: OtherPlay -> OtherPlay -> Bool
Eq,Typeable,(forall x. OtherPlay -> Rep OtherPlay x)
-> (forall x. Rep OtherPlay x -> OtherPlay) -> Generic OtherPlay
forall x. Rep OtherPlay x -> OtherPlay
forall x. OtherPlay -> Rep OtherPlay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherPlay x -> OtherPlay
$cfrom :: forall x. OtherPlay -> Rep OtherPlay x
Generic,Int -> OtherPlay -> ShowS
[OtherPlay] -> ShowS
OtherPlay -> String
(Int -> OtherPlay -> ShowS)
-> (OtherPlay -> String)
-> ([OtherPlay] -> ShowS)
-> Show OtherPlay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherPlay] -> ShowS
$cshowList :: [OtherPlay] -> ShowS
show :: OtherPlay -> String
$cshow :: OtherPlay -> String
showsPrec :: Int -> OtherPlay -> ShowS
$cshowsPrec :: Int -> OtherPlay -> ShowS
Show)
instance EmitXml OtherPlay where
    emitXml :: OtherPlay -> XmlRep
emitXml (OtherPlay String
a Token
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Token
b)])
        []
parseOtherPlay :: P.XParse OtherPlay
parseOtherPlay :: XParse OtherPlay
parseOtherPlay = 
      String -> Token -> OtherPlay
OtherPlay
        (String -> Token -> OtherPlay)
-> XParse String -> XParse (Token -> OtherPlay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Token -> OtherPlay) -> XParse Token -> XParse OtherPlay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'OtherPlay'
mkOtherPlay :: String -> Token -> OtherPlay
mkOtherPlay :: String -> Token -> OtherPlay
mkOtherPlay String
a Token
b = String -> Token -> OtherPlay
OtherPlay String
a Token
b

-- | @other-text@ /(complex)/
--
-- The other-text type represents a text element with a smufl attribute group. This type is used by MusicXML direction extension elements to allow specification of specific SMuFL glyphs without needed to add every glyph as a MusicXML element.
data OtherText = 
      OtherText {
          OtherText -> String
otherTextString :: String -- ^ text content
        , OtherText -> Maybe SmuflGlyphName
otherTextSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
       }
    deriving (OtherText -> OtherText -> Bool
(OtherText -> OtherText -> Bool)
-> (OtherText -> OtherText -> Bool) -> Eq OtherText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherText -> OtherText -> Bool
$c/= :: OtherText -> OtherText -> Bool
== :: OtherText -> OtherText -> Bool
$c== :: OtherText -> OtherText -> Bool
Eq,Typeable,(forall x. OtherText -> Rep OtherText x)
-> (forall x. Rep OtherText x -> OtherText) -> Generic OtherText
forall x. Rep OtherText x -> OtherText
forall x. OtherText -> Rep OtherText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OtherText x -> OtherText
$cfrom :: forall x. OtherText -> Rep OtherText x
Generic,Int -> OtherText -> ShowS
[OtherText] -> ShowS
OtherText -> String
(Int -> OtherText -> ShowS)
-> (OtherText -> String)
-> ([OtherText] -> ShowS)
-> Show OtherText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherText] -> ShowS
$cshowList :: [OtherText] -> ShowS
show :: OtherText -> String
$cshow :: OtherText -> String
showsPrec :: Int -> OtherText -> ShowS
$cshowsPrec :: Int -> OtherText -> ShowS
Show)
instance EmitXml OtherText where
    emitXml :: OtherText -> XmlRep
emitXml (OtherText String
a Maybe SmuflGlyphName
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
b])
        []
parseOtherText :: P.XParse OtherText
parseOtherText :: XParse OtherText
parseOtherText = 
      String -> Maybe SmuflGlyphName -> OtherText
OtherText
        (String -> Maybe SmuflGlyphName -> OtherText)
-> XParse String -> XParse (Maybe SmuflGlyphName -> OtherText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Maybe SmuflGlyphName -> OtherText)
-> XParse (Maybe SmuflGlyphName) -> XParse OtherText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)

-- | Smart constructor for 'OtherText'
mkOtherText :: String -> OtherText
mkOtherText :: String -> OtherText
mkOtherText String
a = String -> Maybe SmuflGlyphName -> OtherText
OtherText String
a Maybe SmuflGlyphName
forall a. Maybe a
Nothing

-- | @page-layout@ /(complex)/
--
-- Page layout can be defined both in score-wide defaults and in the print element. Page margins are specified either for both even and odd pages, or via separate odd and even page number values. The type is not needed when used as part of a print element. If omitted when used in the defaults element, "both" is the default.
data PageLayout = 
      PageLayout {
          PageLayout -> Maybe SeqPageLayout
pageLayoutPageLayout :: (Maybe SeqPageLayout)
        , PageLayout -> [PageMargins]
pageLayoutPageMargins :: [PageMargins] -- ^ /page-margins/ child element
       }
    deriving (PageLayout -> PageLayout -> Bool
(PageLayout -> PageLayout -> Bool)
-> (PageLayout -> PageLayout -> Bool) -> Eq PageLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageLayout -> PageLayout -> Bool
$c/= :: PageLayout -> PageLayout -> Bool
== :: PageLayout -> PageLayout -> Bool
$c== :: PageLayout -> PageLayout -> Bool
Eq,Typeable,(forall x. PageLayout -> Rep PageLayout x)
-> (forall x. Rep PageLayout x -> PageLayout) -> Generic PageLayout
forall x. Rep PageLayout x -> PageLayout
forall x. PageLayout -> Rep PageLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageLayout x -> PageLayout
$cfrom :: forall x. PageLayout -> Rep PageLayout x
Generic,Int -> PageLayout -> ShowS
[PageLayout] -> ShowS
PageLayout -> String
(Int -> PageLayout -> ShowS)
-> (PageLayout -> String)
-> ([PageLayout] -> ShowS)
-> Show PageLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageLayout] -> ShowS
$cshowList :: [PageLayout] -> ShowS
show :: PageLayout -> String
$cshow :: PageLayout -> String
showsPrec :: Int -> PageLayout -> ShowS
$cshowsPrec :: Int -> PageLayout -> ShowS
Show)
instance EmitXml PageLayout where
    emitXml :: PageLayout -> XmlRep
emitXml (PageLayout Maybe SeqPageLayout
a [PageMargins]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([Maybe SeqPageLayout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe SeqPageLayout
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (PageMargins -> XmlRep) -> [PageMargins] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"page-margins" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PageMargins -> XmlRep) -> PageMargins -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PageMargins -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [PageMargins]
b)
parsePageLayout :: P.XParse PageLayout
parsePageLayout :: XParse PageLayout
parsePageLayout = 
      Maybe SeqPageLayout -> [PageMargins] -> PageLayout
PageLayout
        (Maybe SeqPageLayout -> [PageMargins] -> PageLayout)
-> XParse (Maybe SeqPageLayout)
-> XParse ([PageMargins] -> PageLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SeqPageLayout -> XParse (Maybe SeqPageLayout)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse SeqPageLayout
parseSeqPageLayout)
        XParse ([PageMargins] -> PageLayout)
-> XParse [PageMargins] -> XParse PageLayout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PageMargins -> XParse [PageMargins]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse PageMargins -> XParse PageMargins
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"page-margins") (XParse PageMargins
parsePageMargins))

-- | Smart constructor for 'PageLayout'
mkPageLayout :: PageLayout
mkPageLayout :: PageLayout
mkPageLayout = Maybe SeqPageLayout -> [PageMargins] -> PageLayout
PageLayout Maybe SeqPageLayout
forall a. Maybe a
Nothing []

-- | @page-margins@ /(complex)/
--
-- Page margins are specified either for both even and odd pages, or via separate odd and even page number values. The type attribute is not needed when used as part of a print element. If omitted when the page-margins type is used in the defaults element, "both" is the default value.
data PageMargins = 
      PageMargins {
          PageMargins -> Maybe MarginType
pageMarginsType :: (Maybe MarginType) -- ^ /type/ attribute
        , PageMargins -> AllMargins
pageMarginsAllMargins :: AllMargins
       }
    deriving (PageMargins -> PageMargins -> Bool
(PageMargins -> PageMargins -> Bool)
-> (PageMargins -> PageMargins -> Bool) -> Eq PageMargins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageMargins -> PageMargins -> Bool
$c/= :: PageMargins -> PageMargins -> Bool
== :: PageMargins -> PageMargins -> Bool
$c== :: PageMargins -> PageMargins -> Bool
Eq,Typeable,(forall x. PageMargins -> Rep PageMargins x)
-> (forall x. Rep PageMargins x -> PageMargins)
-> Generic PageMargins
forall x. Rep PageMargins x -> PageMargins
forall x. PageMargins -> Rep PageMargins x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageMargins x -> PageMargins
$cfrom :: forall x. PageMargins -> Rep PageMargins x
Generic,Int -> PageMargins -> ShowS
[PageMargins] -> ShowS
PageMargins -> String
(Int -> PageMargins -> ShowS)
-> (PageMargins -> String)
-> ([PageMargins] -> ShowS)
-> Show PageMargins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageMargins] -> ShowS
$cshowList :: [PageMargins] -> ShowS
show :: PageMargins -> String
$cshow :: PageMargins -> String
showsPrec :: Int -> PageMargins -> ShowS
$cshowsPrec :: Int -> PageMargins -> ShowS
Show)
instance EmitXml PageMargins where
    emitXml :: PageMargins -> XmlRep
emitXml (PageMargins Maybe MarginType
a AllMargins
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (MarginType -> XmlRep) -> Maybe MarginType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MarginType -> XmlRep) -> MarginType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MarginType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MarginType
a])
        ([AllMargins -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AllMargins
b])
parsePageMargins :: P.XParse PageMargins
parsePageMargins :: XParse PageMargins
parsePageMargins = 
      Maybe MarginType -> AllMargins -> PageMargins
PageMargins
        (Maybe MarginType -> AllMargins -> PageMargins)
-> XParse (Maybe MarginType) -> XParse (AllMargins -> PageMargins)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse MarginType -> XParse (Maybe MarginType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse MarginType) -> XParse MarginType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse MarginType
parseMarginType)
        XParse (AllMargins -> PageMargins)
-> XParse AllMargins -> XParse PageMargins
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AllMargins
parseAllMargins

-- | Smart constructor for 'PageMargins'
mkPageMargins :: AllMargins -> PageMargins
mkPageMargins :: AllMargins -> PageMargins
mkPageMargins AllMargins
b = Maybe MarginType -> AllMargins -> PageMargins
PageMargins Maybe MarginType
forall a. Maybe a
Nothing AllMargins
b

-- | @part@ /(complex)/
data CmpPart = 
      CmpPart {
          CmpPart -> IDREF
partId :: IDREF -- ^ /id/ attribute
        , CmpPart -> [Measure]
partMeasure :: [Measure] -- ^ /measure/ child element
       }
    deriving (CmpPart -> CmpPart -> Bool
(CmpPart -> CmpPart -> Bool)
-> (CmpPart -> CmpPart -> Bool) -> Eq CmpPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpPart -> CmpPart -> Bool
$c/= :: CmpPart -> CmpPart -> Bool
== :: CmpPart -> CmpPart -> Bool
$c== :: CmpPart -> CmpPart -> Bool
Eq,Typeable,(forall x. CmpPart -> Rep CmpPart x)
-> (forall x. Rep CmpPart x -> CmpPart) -> Generic CmpPart
forall x. Rep CmpPart x -> CmpPart
forall x. CmpPart -> Rep CmpPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpPart x -> CmpPart
$cfrom :: forall x. CmpPart -> Rep CmpPart x
Generic,Int -> CmpPart -> ShowS
[CmpPart] -> ShowS
CmpPart -> String
(Int -> CmpPart -> ShowS)
-> (CmpPart -> String) -> ([CmpPart] -> ShowS) -> Show CmpPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpPart] -> ShowS
$cshowList :: [CmpPart] -> ShowS
show :: CmpPart -> String
$cshow :: CmpPart -> String
showsPrec :: Int -> CmpPart -> ShowS
$cshowsPrec :: Int -> CmpPart -> ShowS
Show)
instance EmitXml CmpPart where
    emitXml :: CmpPart -> XmlRep
emitXml (CmpPart IDREF
a [Measure]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml IDREF
a)])
        ((Measure -> XmlRep) -> [Measure] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Measure -> XmlRep) -> Measure -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Measure -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Measure]
b)
parseCmpPart :: P.XParse CmpPart
parseCmpPart :: XParse CmpPart
parseCmpPart = 
      IDREF -> [Measure] -> CmpPart
CmpPart
        (IDREF -> [Measure] -> CmpPart)
-> XParse IDREF -> XParse ([Measure] -> CmpPart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)
        XParse ([Measure] -> CmpPart) -> XParse [Measure] -> XParse CmpPart
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Measure -> XParse [Measure]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Measure -> XParse Measure
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure") (XParse Measure
parseMeasure))

-- | Smart constructor for 'CmpPart'
mkCmpPart :: IDREF -> CmpPart
mkCmpPart :: IDREF -> CmpPart
mkCmpPart IDREF
a = IDREF -> [Measure] -> CmpPart
CmpPart IDREF
a []

-- | @part@ /(complex)/

-- mangled: 1
data Part = 
      Part {
          Part -> IDREF
cmppartId :: IDREF -- ^ /id/ attribute
        , Part -> MusicData
partMusicData :: MusicData
       }
    deriving (Part -> Part -> Bool
(Part -> Part -> Bool) -> (Part -> Part -> Bool) -> Eq Part
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Part -> Part -> Bool
$c/= :: Part -> Part -> Bool
== :: Part -> Part -> Bool
$c== :: Part -> Part -> Bool
Eq,Typeable,(forall x. Part -> Rep Part x)
-> (forall x. Rep Part x -> Part) -> Generic Part
forall x. Rep Part x -> Part
forall x. Part -> Rep Part x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Part x -> Part
$cfrom :: forall x. Part -> Rep Part x
Generic,Int -> Part -> ShowS
[Part] -> ShowS
Part -> String
(Int -> Part -> ShowS)
-> (Part -> String) -> ([Part] -> ShowS) -> Show Part
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Part] -> ShowS
$cshowList :: [Part] -> ShowS
show :: Part -> String
$cshow :: Part -> String
showsPrec :: Int -> Part -> ShowS
$cshowsPrec :: Int -> Part -> ShowS
Show)
instance EmitXml Part where
    emitXml :: Part -> XmlRep
emitXml (Part IDREF
a MusicData
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml IDREF
a)])
        ([MusicData -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MusicData
b])
parsePart :: P.XParse Part
parsePart :: XParse Part
parsePart = 
      IDREF -> MusicData -> Part
Part
        (IDREF -> MusicData -> Part)
-> XParse IDREF -> XParse (MusicData -> Part)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)
        XParse (MusicData -> Part) -> XParse MusicData -> XParse Part
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MusicData
parseMusicData

-- | Smart constructor for 'Part'
mkPart :: IDREF -> MusicData -> Part
mkPart :: IDREF -> MusicData -> Part
mkPart IDREF
a MusicData
b = IDREF -> MusicData -> Part
Part IDREF
a MusicData
b

-- | @part-group@ /(complex)/
--
-- The part-group element indicates groupings of parts in the score, usually indicated by braces and brackets. Braces that are used for multi-staff parts should be defined in the attributes element for that part. The part-group start element appears before the first score-part in the group. The part-group stop element appears after the last score-part in the group.
-- 
-- The number attribute is used to distinguish overlapping and nested part-groups, not the sequence of groups. As with parts, groups can have a name and abbreviation. Values for the child elements are ignored at the stop of a group.
-- 
-- A part-group element is not needed for a single multi-staff part. By default, multi-staff parts include a brace symbol and (if appropriate given the bar-style) common barlines. The symbol formatting for a multi-staff part can be more fully specified using the part-symbol element.
data PartGroup = 
      PartGroup {
          PartGroup -> StartStop
partGroupType :: StartStop -- ^ /type/ attribute
        , PartGroup -> Maybe Token
partGroupNumber :: (Maybe Token) -- ^ /number/ attribute
        , PartGroup -> Maybe GroupName
partGroupGroupName :: (Maybe GroupName) -- ^ /group-name/ child element
        , PartGroup -> Maybe NameDisplay
partGroupGroupNameDisplay :: (Maybe NameDisplay) -- ^ /group-name-display/ child element
        , PartGroup -> Maybe GroupName
partGroupGroupAbbreviation :: (Maybe GroupName) -- ^ /group-abbreviation/ child element
        , PartGroup -> Maybe NameDisplay
partGroupGroupAbbreviationDisplay :: (Maybe NameDisplay) -- ^ /group-abbreviation-display/ child element
        , PartGroup -> Maybe GroupSymbol
partGroupGroupSymbol :: (Maybe GroupSymbol) -- ^ /group-symbol/ child element
        , PartGroup -> Maybe GroupBarline
partGroupGroupBarline :: (Maybe GroupBarline) -- ^ /group-barline/ child element
        , PartGroup -> Maybe Empty
partGroupGroupTime :: (Maybe Empty) -- ^ /group-time/ child element
        , PartGroup -> Editorial
partGroupEditorial :: Editorial
       }
    deriving (PartGroup -> PartGroup -> Bool
(PartGroup -> PartGroup -> Bool)
-> (PartGroup -> PartGroup -> Bool) -> Eq PartGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartGroup -> PartGroup -> Bool
$c/= :: PartGroup -> PartGroup -> Bool
== :: PartGroup -> PartGroup -> Bool
$c== :: PartGroup -> PartGroup -> Bool
Eq,Typeable,(forall x. PartGroup -> Rep PartGroup x)
-> (forall x. Rep PartGroup x -> PartGroup) -> Generic PartGroup
forall x. Rep PartGroup x -> PartGroup
forall x. PartGroup -> Rep PartGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartGroup x -> PartGroup
$cfrom :: forall x. PartGroup -> Rep PartGroup x
Generic,Int -> PartGroup -> ShowS
[PartGroup] -> ShowS
PartGroup -> String
(Int -> PartGroup -> ShowS)
-> (PartGroup -> String)
-> ([PartGroup] -> ShowS)
-> Show PartGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartGroup] -> ShowS
$cshowList :: [PartGroup] -> ShowS
show :: PartGroup -> String
$cshow :: PartGroup -> String
showsPrec :: Int -> PartGroup -> ShowS
$cshowsPrec :: Int -> PartGroup -> ShowS
Show)
instance EmitXml PartGroup where
    emitXml :: PartGroup -> XmlRep
emitXml (PartGroup StartStop
a Maybe Token
b Maybe GroupName
c Maybe NameDisplay
d Maybe GroupName
e Maybe NameDisplay
f Maybe GroupSymbol
g Maybe GroupBarline
h Maybe Empty
i Editorial
j) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b])
        ([XmlRep -> (GroupName -> XmlRep) -> Maybe GroupName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (GroupName -> XmlRep) -> GroupName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GroupName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe GroupName
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-name-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (GroupName -> XmlRep) -> Maybe GroupName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-abbreviation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (GroupName -> XmlRep) -> GroupName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GroupName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe GroupName
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-abbreviation-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (GroupSymbol -> XmlRep) -> Maybe GroupSymbol -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-symbol" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (GroupSymbol -> XmlRep) -> GroupSymbol -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GroupSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe GroupSymbol
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (GroupBarline -> XmlRep) -> Maybe GroupBarline -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-barline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (GroupBarline -> XmlRep) -> GroupBarline -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GroupBarline -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe GroupBarline
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group-time" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Editorial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Editorial
j])
parsePartGroup :: P.XParse PartGroup
parsePartGroup :: XParse PartGroup
parsePartGroup = 
      StartStop
-> Maybe Token
-> Maybe GroupName
-> Maybe NameDisplay
-> Maybe GroupName
-> Maybe NameDisplay
-> Maybe GroupSymbol
-> Maybe GroupBarline
-> Maybe Empty
-> Editorial
-> PartGroup
PartGroup
        (StartStop
 -> Maybe Token
 -> Maybe GroupName
 -> Maybe NameDisplay
 -> Maybe GroupName
 -> Maybe NameDisplay
 -> Maybe GroupSymbol
 -> Maybe GroupBarline
 -> Maybe Empty
 -> Editorial
 -> PartGroup)
-> XParse StartStop
-> XParse
     (Maybe Token
      -> Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupSymbol
      -> Maybe GroupBarline
      -> Maybe Empty
      -> Editorial
      -> PartGroup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe Token
   -> Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupSymbol
   -> Maybe GroupBarline
   -> Maybe Empty
   -> Editorial
   -> PartGroup)
-> XParse (Maybe Token)
-> XParse
     (Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupSymbol
      -> Maybe GroupBarline
      -> Maybe Empty
      -> Editorial
      -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupSymbol
   -> Maybe GroupBarline
   -> Maybe Empty
   -> Editorial
   -> PartGroup)
-> XParse (Maybe GroupName)
-> XParse
     (Maybe NameDisplay
      -> Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupSymbol
      -> Maybe GroupBarline
      -> Maybe Empty
      -> Editorial
      -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GroupName -> XParse (Maybe GroupName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse GroupName -> XParse GroupName
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-name") (XParse GroupName
parseGroupName))
        XParse
  (Maybe NameDisplay
   -> Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupSymbol
   -> Maybe GroupBarline
   -> Maybe Empty
   -> Editorial
   -> PartGroup)
-> XParse (Maybe NameDisplay)
-> XParse
     (Maybe GroupName
      -> Maybe NameDisplay
      -> Maybe GroupSymbol
      -> Maybe GroupBarline
      -> Maybe Empty
      -> Editorial
      -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-name-display") (XParse NameDisplay
parseNameDisplay))
        XParse
  (Maybe GroupName
   -> Maybe NameDisplay
   -> Maybe GroupSymbol
   -> Maybe GroupBarline
   -> Maybe Empty
   -> Editorial
   -> PartGroup)
-> XParse (Maybe GroupName)
-> XParse
     (Maybe NameDisplay
      -> Maybe GroupSymbol
      -> Maybe GroupBarline
      -> Maybe Empty
      -> Editorial
      -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GroupName -> XParse (Maybe GroupName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse GroupName -> XParse GroupName
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-abbreviation") (XParse GroupName
parseGroupName))
        XParse
  (Maybe NameDisplay
   -> Maybe GroupSymbol
   -> Maybe GroupBarline
   -> Maybe Empty
   -> Editorial
   -> PartGroup)
-> XParse (Maybe NameDisplay)
-> XParse
     (Maybe GroupSymbol
      -> Maybe GroupBarline -> Maybe Empty -> Editorial -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-abbreviation-display") (XParse NameDisplay
parseNameDisplay))
        XParse
  (Maybe GroupSymbol
   -> Maybe GroupBarline -> Maybe Empty -> Editorial -> PartGroup)
-> XParse (Maybe GroupSymbol)
-> XParse
     (Maybe GroupBarline -> Maybe Empty -> Editorial -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GroupSymbol -> XParse (Maybe GroupSymbol)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse GroupSymbol -> XParse GroupSymbol
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-symbol") (XParse GroupSymbol
parseGroupSymbol))
        XParse
  (Maybe GroupBarline -> Maybe Empty -> Editorial -> PartGroup)
-> XParse (Maybe GroupBarline)
-> XParse (Maybe Empty -> Editorial -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GroupBarline -> XParse (Maybe GroupBarline)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse GroupBarline -> XParse GroupBarline
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-barline") (XParse GroupBarline
parseGroupBarline))
        XParse (Maybe Empty -> Editorial -> PartGroup)
-> XParse (Maybe Empty) -> XParse (Editorial -> PartGroup)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group-time") (XParse Empty
parseEmpty))
        XParse (Editorial -> PartGroup)
-> XParse Editorial -> XParse PartGroup
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Editorial
parseEditorial

-- | Smart constructor for 'PartGroup'
mkPartGroup :: StartStop -> Editorial -> PartGroup
mkPartGroup :: StartStop -> Editorial -> PartGroup
mkPartGroup StartStop
a Editorial
j = StartStop
-> Maybe Token
-> Maybe GroupName
-> Maybe NameDisplay
-> Maybe GroupName
-> Maybe NameDisplay
-> Maybe GroupSymbol
-> Maybe GroupBarline
-> Maybe Empty
-> Editorial
-> PartGroup
PartGroup StartStop
a Maybe Token
forall a. Maybe a
Nothing Maybe GroupName
forall a. Maybe a
Nothing Maybe NameDisplay
forall a. Maybe a
Nothing Maybe GroupName
forall a. Maybe a
Nothing Maybe NameDisplay
forall a. Maybe a
Nothing Maybe GroupSymbol
forall a. Maybe a
Nothing Maybe GroupBarline
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing Editorial
j

-- | @part-list@ /(complex)/
--
-- The part-list identifies the different musical parts in this movement. Each part has an ID that is used later within the musical data. Since parts may be encoded separately and combined later, identification elements are present at both the score and score-part levels. There must be at least one score-part, combined as desired with part-group elements that indicate braces and brackets. Parts are ordered from top to bottom in a score based on the order in which they appear in the part-list.
data PartList = 
      PartList {
          PartList -> [GrpPartGroup]
partListPartGroup :: [GrpPartGroup]
        , PartList -> ScorePart
partListScorePart :: ScorePart
        , PartList -> [ChxPartList]
partListPartList :: [ChxPartList]
       }
    deriving (PartList -> PartList -> Bool
(PartList -> PartList -> Bool)
-> (PartList -> PartList -> Bool) -> Eq PartList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartList -> PartList -> Bool
$c/= :: PartList -> PartList -> Bool
== :: PartList -> PartList -> Bool
$c== :: PartList -> PartList -> Bool
Eq,Typeable,(forall x. PartList -> Rep PartList x)
-> (forall x. Rep PartList x -> PartList) -> Generic PartList
forall x. Rep PartList x -> PartList
forall x. PartList -> Rep PartList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartList x -> PartList
$cfrom :: forall x. PartList -> Rep PartList x
Generic,Int -> PartList -> ShowS
[PartList] -> ShowS
PartList -> String
(Int -> PartList -> ShowS)
-> (PartList -> String) -> ([PartList] -> ShowS) -> Show PartList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartList] -> ShowS
$cshowList :: [PartList] -> ShowS
show :: PartList -> String
$cshow :: PartList -> String
showsPrec :: Int -> PartList -> ShowS
$cshowsPrec :: Int -> PartList -> ShowS
Show)
instance EmitXml PartList where
    emitXml :: PartList -> XmlRep
emitXml (PartList [GrpPartGroup]
a ScorePart
b [ChxPartList]
c) =
      [XmlRep] -> XmlRep
XReps [[GrpPartGroup] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [GrpPartGroup]
a,ScorePart -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ScorePart
b,[ChxPartList] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxPartList]
c]
parsePartList :: P.XParse PartList
parsePartList :: XParse PartList
parsePartList = 
      [GrpPartGroup] -> ScorePart -> [ChxPartList] -> PartList
PartList
        ([GrpPartGroup] -> ScorePart -> [ChxPartList] -> PartList)
-> XParse [GrpPartGroup]
-> XParse (ScorePart -> [ChxPartList] -> PartList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse GrpPartGroup -> XParse [GrpPartGroup]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse GrpPartGroup
parseGrpPartGroup)
        XParse (ScorePart -> [ChxPartList] -> PartList)
-> XParse ScorePart -> XParse ([ChxPartList] -> PartList)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ScorePart
parseScorePart
        XParse ([ChxPartList] -> PartList)
-> XParse [ChxPartList] -> XParse PartList
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxPartList -> XParse [ChxPartList]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxPartList
parseChxPartList)

-- | Smart constructor for 'PartList'
mkPartList :: ScorePart -> PartList
mkPartList :: ScorePart -> PartList
mkPartList ScorePart
b = [GrpPartGroup] -> ScorePart -> [ChxPartList] -> PartList
PartList [] ScorePart
b []

-- | @part-name@ /(complex)/
--
-- The part-name type describes the name or abbreviation of a score-part element. Formatting attributes for the part-name element are deprecated in Version 2.0 in favor of the new part-name-display and part-abbreviation-display elements.
data PartName = 
      PartName {
          PartName -> String
partNameString :: String -- ^ text content
        , PartName -> Maybe Tenths
partNameDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , PartName -> Maybe Tenths
partNameDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , PartName -> Maybe Tenths
partNameRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , PartName -> Maybe Tenths
partNameRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , PartName -> Maybe CommaSeparatedText
partNameFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , PartName -> Maybe FontStyle
partNameFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , PartName -> Maybe FontSize
partNameFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , PartName -> Maybe FontWeight
partNameFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , PartName -> Maybe Color
partNameColor :: (Maybe Color) -- ^ /color/ attribute
        , PartName -> Maybe YesNo
partNamePrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , PartName -> Maybe LeftCenterRight
partNameJustify :: (Maybe LeftCenterRight) -- ^ /justify/ attribute
       }
    deriving (PartName -> PartName -> Bool
(PartName -> PartName -> Bool)
-> (PartName -> PartName -> Bool) -> Eq PartName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartName -> PartName -> Bool
$c/= :: PartName -> PartName -> Bool
== :: PartName -> PartName -> Bool
$c== :: PartName -> PartName -> Bool
Eq,Typeable,(forall x. PartName -> Rep PartName x)
-> (forall x. Rep PartName x -> PartName) -> Generic PartName
forall x. Rep PartName x -> PartName
forall x. PartName -> Rep PartName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartName x -> PartName
$cfrom :: forall x. PartName -> Rep PartName x
Generic,Int -> PartName -> ShowS
[PartName] -> ShowS
PartName -> String
(Int -> PartName -> ShowS)
-> (PartName -> String) -> ([PartName] -> ShowS) -> Show PartName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartName] -> ShowS
$cshowList :: [PartName] -> ShowS
show :: PartName -> String
$cshow :: PartName -> String
showsPrec :: Int -> PartName -> ShowS
$cshowsPrec :: Int -> PartName -> ShowS
Show)
instance EmitXml PartName where
    emitXml :: PartName -> XmlRep
emitXml (PartName String
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe YesNo
k Maybe LeftCenterRight
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"justify" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
l])
        []
parsePartName :: P.XParse PartName
parsePartName :: XParse PartName
parsePartName = 
      String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe LeftCenterRight
-> PartName
PartName
        (String
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe LeftCenterRight
 -> PartName)
-> XParse String
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe LeftCenterRight
      -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe LeftCenterRight
   -> PartName)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe YesNo -> Maybe LeftCenterRight -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe YesNo -> Maybe LeftCenterRight -> PartName)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color -> Maybe YesNo -> Maybe LeftCenterRight -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color -> Maybe YesNo -> Maybe LeftCenterRight -> PartName)
-> XParse (Maybe Color)
-> XParse (Maybe YesNo -> Maybe LeftCenterRight -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe YesNo -> Maybe LeftCenterRight -> PartName)
-> XParse (Maybe YesNo)
-> XParse (Maybe LeftCenterRight -> PartName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe LeftCenterRight -> PartName)
-> XParse (Maybe LeftCenterRight) -> XParse PartName
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"justify") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)

-- | Smart constructor for 'PartName'
mkPartName :: String -> PartName
mkPartName :: String -> PartName
mkPartName String
a = String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe LeftCenterRight
-> PartName
PartName String
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing

-- | @part-symbol@ /(complex)/
--
-- The part-symbol type indicates how a symbol for a multi-staff part is indicated in the score; brace is the default value. The top-staff and bottom-staff elements are used when the brace does not extend across the entire part. For example, in a 3-staff organ part, the top-staff will typically be 1 for the right hand, while the bottom-staff will typically be 2 for the left hand. Staff 3 for the pedals is usually outside the brace.
data PartSymbol = 
      PartSymbol {
          PartSymbol -> GroupSymbolValue
partSymbolGroupSymbolValue :: GroupSymbolValue -- ^ text content
        , PartSymbol -> Maybe StaffNumber
partSymbolTopStaff :: (Maybe StaffNumber) -- ^ /top-staff/ attribute
        , PartSymbol -> Maybe StaffNumber
partSymbolBottomStaff :: (Maybe StaffNumber) -- ^ /bottom-staff/ attribute
        , PartSymbol -> Maybe Tenths
partSymbolDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , PartSymbol -> Maybe Tenths
partSymbolDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , PartSymbol -> Maybe Tenths
partSymbolRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , PartSymbol -> Maybe Tenths
partSymbolRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , PartSymbol -> Maybe Color
partSymbolColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (PartSymbol -> PartSymbol -> Bool
(PartSymbol -> PartSymbol -> Bool)
-> (PartSymbol -> PartSymbol -> Bool) -> Eq PartSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartSymbol -> PartSymbol -> Bool
$c/= :: PartSymbol -> PartSymbol -> Bool
== :: PartSymbol -> PartSymbol -> Bool
$c== :: PartSymbol -> PartSymbol -> Bool
Eq,Typeable,(forall x. PartSymbol -> Rep PartSymbol x)
-> (forall x. Rep PartSymbol x -> PartSymbol) -> Generic PartSymbol
forall x. Rep PartSymbol x -> PartSymbol
forall x. PartSymbol -> Rep PartSymbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartSymbol x -> PartSymbol
$cfrom :: forall x. PartSymbol -> Rep PartSymbol x
Generic,Int -> PartSymbol -> ShowS
[PartSymbol] -> ShowS
PartSymbol -> String
(Int -> PartSymbol -> ShowS)
-> (PartSymbol -> String)
-> ([PartSymbol] -> ShowS)
-> Show PartSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartSymbol] -> ShowS
$cshowList :: [PartSymbol] -> ShowS
show :: PartSymbol -> String
$cshow :: PartSymbol -> String
showsPrec :: Int -> PartSymbol -> ShowS
$cshowsPrec :: Int -> PartSymbol -> ShowS
Show)
instance EmitXml PartSymbol where
    emitXml :: PartSymbol -> XmlRep
emitXml (PartSymbol GroupSymbolValue
a Maybe StaffNumber
b Maybe StaffNumber
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Color
h) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (GroupSymbolValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GroupSymbolValue
a)
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"top-staff" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bottom-staff" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h])
        []
parsePartSymbol :: P.XParse PartSymbol
parsePartSymbol :: XParse PartSymbol
parsePartSymbol = 
      GroupSymbolValue
-> Maybe StaffNumber
-> Maybe StaffNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> PartSymbol
PartSymbol
        (GroupSymbolValue
 -> Maybe StaffNumber
 -> Maybe StaffNumber
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> PartSymbol)
-> XParse GroupSymbolValue
-> XParse
     (Maybe StaffNumber
      -> Maybe StaffNumber
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> PartSymbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse GroupSymbolValue) -> XParse GroupSymbolValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse GroupSymbolValue
parseGroupSymbolValue)
        XParse
  (Maybe StaffNumber
   -> Maybe StaffNumber
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> PartSymbol)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe StaffNumber
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"top-staff") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe StaffNumber
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> PartSymbol)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bottom-staff") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> PartSymbol)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> PartSymbol)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths -> Maybe Tenths -> Maybe Color -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> PartSymbol)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> PartSymbol)
-> XParse (Maybe Tenths) -> XParse (Maybe Color -> PartSymbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> PartSymbol)
-> XParse (Maybe Color) -> XParse PartSymbol
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'PartSymbol'
mkPartSymbol :: GroupSymbolValue -> PartSymbol
mkPartSymbol :: GroupSymbolValue -> PartSymbol
mkPartSymbol GroupSymbolValue
a = GroupSymbolValue
-> Maybe StaffNumber
-> Maybe StaffNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> PartSymbol
PartSymbol GroupSymbolValue
a Maybe StaffNumber
forall a. Maybe a
Nothing Maybe StaffNumber
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @pedal@ /(complex)/
--
-- The pedal type represents piano pedal marks. In MusicXML 3.1 this includes sostenuto as well as damper pedal marks. The line attribute is yes if pedal lines are used. The sign attribute is yes if Ped, Sost, and * signs are used. For MusicXML 2.0 compatibility, the sign attribute is yes by default if the line attribute is no, and is no by default if the line attribute is yes. If the sign attribute is set to yes and the type is start or sostenuto, the abbreviated attribute is yes if the short P and S signs are used, and no if the full Ped and Sost signs are used. It is no by default. Otherwise the abbreviated attribute is ignored.
-- 
-- The change and continue types are used when the line attribute is yes. The change type indicates a pedal lift and retake indicated with an inverted V marking. The continue type allows more precise formatting across system breaks and for more complex pedaling lines. The alignment attributes are ignored if the line attribute is yes.
data Pedal = 
      Pedal {
          Pedal -> PedalType
pedalType :: PedalType -- ^ /type/ attribute
        , Pedal -> Maybe NumberLevel
pedalNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Pedal -> Maybe YesNo
pedalLine :: (Maybe YesNo) -- ^ /line/ attribute
        , Pedal -> Maybe YesNo
pedalSign :: (Maybe YesNo) -- ^ /sign/ attribute
        , Pedal -> Maybe YesNo
pedalAbbreviated :: (Maybe YesNo) -- ^ /abbreviated/ attribute
        , Pedal -> Maybe Tenths
pedalDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Pedal -> Maybe Tenths
pedalDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Pedal -> Maybe Tenths
pedalRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Pedal -> Maybe Tenths
pedalRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Pedal -> Maybe CommaSeparatedText
pedalFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Pedal -> Maybe FontStyle
pedalFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Pedal -> Maybe FontSize
pedalFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Pedal -> Maybe FontWeight
pedalFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Pedal -> Maybe Color
pedalColor :: (Maybe Color) -- ^ /color/ attribute
        , Pedal -> Maybe LeftCenterRight
pedalHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Pedal -> Maybe Valign
pedalValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Pedal -> Maybe ID
pedalId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Pedal -> Pedal -> Bool
(Pedal -> Pedal -> Bool) -> (Pedal -> Pedal -> Bool) -> Eq Pedal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pedal -> Pedal -> Bool
$c/= :: Pedal -> Pedal -> Bool
== :: Pedal -> Pedal -> Bool
$c== :: Pedal -> Pedal -> Bool
Eq,Typeable,(forall x. Pedal -> Rep Pedal x)
-> (forall x. Rep Pedal x -> Pedal) -> Generic Pedal
forall x. Rep Pedal x -> Pedal
forall x. Pedal -> Rep Pedal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pedal x -> Pedal
$cfrom :: forall x. Pedal -> Rep Pedal x
Generic,Int -> Pedal -> ShowS
[Pedal] -> ShowS
Pedal -> String
(Int -> Pedal -> ShowS)
-> (Pedal -> String) -> ([Pedal] -> ShowS) -> Show Pedal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pedal] -> ShowS
$cshowList :: [Pedal] -> ShowS
show :: Pedal -> String
$cshow :: Pedal -> String
showsPrec :: Int -> Pedal -> ShowS
$cshowsPrec :: Int -> Pedal -> ShowS
Show)
instance EmitXml Pedal where
    emitXml :: Pedal -> XmlRep
emitXml (Pedal PedalType
a Maybe NumberLevel
b Maybe YesNo
c Maybe YesNo
d Maybe YesNo
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe CommaSeparatedText
j Maybe FontStyle
k Maybe FontSize
l Maybe FontWeight
m Maybe Color
n Maybe LeftCenterRight
o Maybe Valign
p Maybe ID
q) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (PedalType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PedalType
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"sign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"abbreviated" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
q])
        []
parsePedal :: P.XParse Pedal
parsePedal :: XParse Pedal
parsePedal = 
      PedalType
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Pedal
Pedal
        (PedalType
 -> Maybe NumberLevel
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> Pedal)
-> XParse PedalType
-> XParse
     (Maybe NumberLevel
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse PedalType) -> XParse PedalType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PedalType
parsePedalType)
        XParse
  (Maybe NumberLevel
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"sign") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"abbreviated") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Pedal)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Pedal)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Pedal)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> Pedal)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> Pedal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> Pedal) -> XParse (Maybe ID) -> XParse Pedal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Pedal'
mkPedal :: PedalType -> Pedal
mkPedal :: PedalType -> Pedal
mkPedal PedalType
a = PedalType
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe YesNo
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Pedal
Pedal PedalType
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @pedal-tuning@ /(complex)/
--
-- The pedal-tuning type specifies the tuning of a single harp pedal.
data PedalTuning = 
      PedalTuning {
          PedalTuning -> Step
pedalTuningPedalStep :: Step -- ^ /pedal-step/ child element
        , PedalTuning -> Semitones
pedalTuningPedalAlter :: Semitones -- ^ /pedal-alter/ child element
       }
    deriving (PedalTuning -> PedalTuning -> Bool
(PedalTuning -> PedalTuning -> Bool)
-> (PedalTuning -> PedalTuning -> Bool) -> Eq PedalTuning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PedalTuning -> PedalTuning -> Bool
$c/= :: PedalTuning -> PedalTuning -> Bool
== :: PedalTuning -> PedalTuning -> Bool
$c== :: PedalTuning -> PedalTuning -> Bool
Eq,Typeable,(forall x. PedalTuning -> Rep PedalTuning x)
-> (forall x. Rep PedalTuning x -> PedalTuning)
-> Generic PedalTuning
forall x. Rep PedalTuning x -> PedalTuning
forall x. PedalTuning -> Rep PedalTuning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PedalTuning x -> PedalTuning
$cfrom :: forall x. PedalTuning -> Rep PedalTuning x
Generic,Int -> PedalTuning -> ShowS
[PedalTuning] -> ShowS
PedalTuning -> String
(Int -> PedalTuning -> ShowS)
-> (PedalTuning -> String)
-> ([PedalTuning] -> ShowS)
-> Show PedalTuning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PedalTuning] -> ShowS
$cshowList :: [PedalTuning] -> ShowS
show :: PedalTuning -> String
$cshow :: PedalTuning -> String
showsPrec :: Int -> PedalTuning -> ShowS
$cshowsPrec :: Int -> PedalTuning -> ShowS
Show)
instance EmitXml PedalTuning where
    emitXml :: PedalTuning -> XmlRep
emitXml (PedalTuning Step
a Semitones
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pedal-step" Maybe String
forall a. Maybe a
Nothing) (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pedal-alter" Maybe String
forall a. Maybe a
Nothing) (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
b)])
parsePedalTuning :: P.XParse PedalTuning
parsePedalTuning :: XParse PedalTuning
parsePedalTuning = 
      Step -> Semitones -> PedalTuning
PedalTuning
        (Step -> Semitones -> PedalTuning)
-> XParse Step -> XParse (Semitones -> PedalTuning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Step -> XParse Step
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pedal-step") (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep))
        XParse (Semitones -> PedalTuning)
-> XParse Semitones -> XParse PedalTuning
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pedal-alter") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))

-- | Smart constructor for 'PedalTuning'
mkPedalTuning :: Step -> Semitones -> PedalTuning
mkPedalTuning :: Step -> Semitones -> PedalTuning
mkPedalTuning Step
a Semitones
b = Step -> Semitones -> PedalTuning
PedalTuning Step
a Semitones
b

-- | @per-minute@ /(complex)/
--
-- The per-minute type can be a number, or a text description including numbers. If a font is specified, it overrides the font specified for the overall metronome element. This allows separate specification of a music font for the beat-unit and a text font for the numeric value, in cases where a single metronome font is not used.
data PerMinute = 
      PerMinute {
          PerMinute -> String
perMinuteString :: String -- ^ text content
        , PerMinute -> Maybe CommaSeparatedText
perMinuteFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , PerMinute -> Maybe FontStyle
perMinuteFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , PerMinute -> Maybe FontSize
perMinuteFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , PerMinute -> Maybe FontWeight
perMinuteFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
       }
    deriving (PerMinute -> PerMinute -> Bool
(PerMinute -> PerMinute -> Bool)
-> (PerMinute -> PerMinute -> Bool) -> Eq PerMinute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PerMinute -> PerMinute -> Bool
$c/= :: PerMinute -> PerMinute -> Bool
== :: PerMinute -> PerMinute -> Bool
$c== :: PerMinute -> PerMinute -> Bool
Eq,Typeable,(forall x. PerMinute -> Rep PerMinute x)
-> (forall x. Rep PerMinute x -> PerMinute) -> Generic PerMinute
forall x. Rep PerMinute x -> PerMinute
forall x. PerMinute -> Rep PerMinute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PerMinute x -> PerMinute
$cfrom :: forall x. PerMinute -> Rep PerMinute x
Generic,Int -> PerMinute -> ShowS
[PerMinute] -> ShowS
PerMinute -> String
(Int -> PerMinute -> ShowS)
-> (PerMinute -> String)
-> ([PerMinute] -> ShowS)
-> Show PerMinute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PerMinute] -> ShowS
$cshowList :: [PerMinute] -> ShowS
show :: PerMinute -> String
$cshow :: PerMinute -> String
showsPrec :: Int -> PerMinute -> ShowS
$cshowsPrec :: Int -> PerMinute -> ShowS
Show)
instance EmitXml PerMinute where
    emitXml :: PerMinute -> XmlRep
emitXml (PerMinute String
a Maybe CommaSeparatedText
b Maybe FontStyle
c Maybe FontSize
d Maybe FontWeight
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
e])
        []
parsePerMinute :: P.XParse PerMinute
parsePerMinute :: XParse PerMinute
parsePerMinute = 
      String
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> PerMinute
PerMinute
        (String
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> PerMinute)
-> XParse String
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> PerMinute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> PerMinute)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> PerMinute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> PerMinute)
-> XParse (Maybe FontStyle)
-> XParse (Maybe FontSize -> Maybe FontWeight -> PerMinute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse (Maybe FontSize -> Maybe FontWeight -> PerMinute)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> PerMinute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> PerMinute)
-> XParse (Maybe FontWeight) -> XParse PerMinute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)

-- | Smart constructor for 'PerMinute'
mkPerMinute :: String -> PerMinute
mkPerMinute :: String -> PerMinute
mkPerMinute String
a = String
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> PerMinute
PerMinute String
a Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing

-- | @percussion@ /(complex)/
--
-- The percussion element is used to define percussion pictogram symbols. Definitions for these symbols can be found in Kurt Stone's "Music Notation in the Twentieth Century" on pages 206-212 and 223. Some values are added to these based on how usage has evolved in the 30 years since Stone's book was published.
data Percussion = 
      Percussion {
          Percussion -> Maybe Tenths
percussionDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Percussion -> Maybe Tenths
percussionDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Percussion -> Maybe Tenths
percussionRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Percussion -> Maybe Tenths
percussionRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Percussion -> Maybe CommaSeparatedText
percussionFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Percussion -> Maybe FontStyle
percussionFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Percussion -> Maybe FontSize
percussionFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Percussion -> Maybe FontWeight
percussionFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Percussion -> Maybe Color
percussionColor :: (Maybe Color) -- ^ /color/ attribute
        , Percussion -> Maybe LeftCenterRight
percussionHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Percussion -> Maybe Valign
percussionValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Percussion -> Maybe EnclosureShape
percussionEnclosure :: (Maybe EnclosureShape) -- ^ /enclosure/ attribute
        , Percussion -> Maybe ID
percussionId :: (Maybe ID) -- ^ /id/ attribute
        , Percussion -> ChxPercussion
percussionPercussion :: ChxPercussion
       }
    deriving (Percussion -> Percussion -> Bool
(Percussion -> Percussion -> Bool)
-> (Percussion -> Percussion -> Bool) -> Eq Percussion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Percussion -> Percussion -> Bool
$c/= :: Percussion -> Percussion -> Bool
== :: Percussion -> Percussion -> Bool
$c== :: Percussion -> Percussion -> Bool
Eq,Typeable,(forall x. Percussion -> Rep Percussion x)
-> (forall x. Rep Percussion x -> Percussion) -> Generic Percussion
forall x. Rep Percussion x -> Percussion
forall x. Percussion -> Rep Percussion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Percussion x -> Percussion
$cfrom :: forall x. Percussion -> Rep Percussion x
Generic,Int -> Percussion -> ShowS
[Percussion] -> ShowS
Percussion -> String
(Int -> Percussion -> ShowS)
-> (Percussion -> String)
-> ([Percussion] -> ShowS)
-> Show Percussion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Percussion] -> ShowS
$cshowList :: [Percussion] -> ShowS
show :: Percussion -> String
$cshow :: Percussion -> String
showsPrec :: Int -> Percussion -> ShowS
$cshowsPrec :: Int -> Percussion -> ShowS
Show)
instance EmitXml Percussion where
    emitXml :: Percussion -> XmlRep
emitXml (Percussion Maybe Tenths
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe CommaSeparatedText
e Maybe FontStyle
f Maybe FontSize
g Maybe FontWeight
h Maybe Color
i Maybe LeftCenterRight
j Maybe Valign
k Maybe EnclosureShape
l Maybe ID
m ChxPercussion
n) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (EnclosureShape -> XmlRep) -> Maybe EnclosureShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"enclosure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (EnclosureShape -> XmlRep) -> EnclosureShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.EnclosureShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe EnclosureShape
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        ([ChxPercussion -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxPercussion
n])
parsePercussion :: P.XParse Percussion
parsePercussion :: XParse Percussion
parsePercussion = 
      Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe EnclosureShape
-> Maybe ID
-> ChxPercussion
-> Percussion
Percussion
        (Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe EnclosureShape
 -> Maybe ID
 -> ChxPercussion
 -> Percussion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe EnclosureShape
      -> Maybe ID
      -> ChxPercussion
      -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe EnclosureShape
   -> Maybe ID
   -> ChxPercussion
   -> Percussion)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign
      -> Maybe EnclosureShape -> Maybe ID -> ChxPercussion -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse
  (Maybe Valign
   -> Maybe EnclosureShape -> Maybe ID -> ChxPercussion -> Percussion)
-> XParse (Maybe Valign)
-> XParse
     (Maybe EnclosureShape -> Maybe ID -> ChxPercussion -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse
  (Maybe EnclosureShape -> Maybe ID -> ChxPercussion -> Percussion)
-> XParse (Maybe EnclosureShape)
-> XParse (Maybe ID -> ChxPercussion -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse EnclosureShape -> XParse (Maybe EnclosureShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"enclosure") XParse String
-> (String -> XParse EnclosureShape) -> XParse EnclosureShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse EnclosureShape
parseEnclosureShape)
        XParse (Maybe ID -> ChxPercussion -> Percussion)
-> XParse (Maybe ID) -> XParse (ChxPercussion -> Percussion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxPercussion -> Percussion)
-> XParse ChxPercussion -> XParse Percussion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxPercussion
parseChxPercussion

-- | Smart constructor for 'Percussion'
mkPercussion :: ChxPercussion -> Percussion
mkPercussion :: ChxPercussion -> Percussion
mkPercussion ChxPercussion
n = Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe EnclosureShape
-> Maybe ID
-> ChxPercussion
-> Percussion
Percussion Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe EnclosureShape
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxPercussion
n

-- | @pitch@ /(complex)/
--
-- Pitch is represented as a combination of the step of the diatonic scale, the chromatic alteration, and the octave.
data Pitch = 
      Pitch {
          Pitch -> Step
pitchStep :: Step -- ^ /step/ child element
        , Pitch -> Maybe Semitones
pitchAlter :: (Maybe Semitones) -- ^ /alter/ child element
        , Pitch -> Octave
pitchOctave :: Octave -- ^ /octave/ child element
       }
    deriving (Pitch -> Pitch -> Bool
(Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> Eq Pitch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch -> Pitch -> Bool
$c/= :: Pitch -> Pitch -> Bool
== :: Pitch -> Pitch -> Bool
$c== :: Pitch -> Pitch -> Bool
Eq,Typeable,(forall x. Pitch -> Rep Pitch x)
-> (forall x. Rep Pitch x -> Pitch) -> Generic Pitch
forall x. Rep Pitch x -> Pitch
forall x. Pitch -> Rep Pitch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pitch x -> Pitch
$cfrom :: forall x. Pitch -> Rep Pitch x
Generic,Int -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> String
(Int -> Pitch -> ShowS)
-> (Pitch -> String) -> ([Pitch] -> ShowS) -> Show Pitch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Int -> Pitch -> ShowS
$cshowsPrec :: Int -> Pitch -> ShowS
Show)
instance EmitXml Pitch where
    emitXml :: Pitch -> XmlRep
emitXml (Pitch Step
a Maybe Semitones
b Octave
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"step" Maybe String
forall a. Maybe a
Nothing) (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Semitones -> XmlRep) -> Maybe Semitones -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"alter" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Semitones -> XmlRep) -> Semitones -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Semitones
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"octave" Maybe String
forall a. Maybe a
Nothing) (Octave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Octave
c)])
parsePitch :: P.XParse Pitch
parsePitch :: XParse Pitch
parsePitch = 
      Step -> Maybe Semitones -> Octave -> Pitch
Pitch
        (Step -> Maybe Semitones -> Octave -> Pitch)
-> XParse Step -> XParse (Maybe Semitones -> Octave -> Pitch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Step -> XParse Step
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"step") (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep))
        XParse (Maybe Semitones -> Octave -> Pitch)
-> XParse (Maybe Semitones) -> XParse (Octave -> Pitch)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Semitones -> XParse (Maybe Semitones)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"alter") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))
        XParse (Octave -> Pitch) -> XParse Octave -> XParse Pitch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Octave -> XParse Octave
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"octave") (XParse String
P.xtext XParse String -> (String -> XParse Octave) -> XParse Octave
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Octave
parseOctave))

-- | Smart constructor for 'Pitch'
mkPitch :: Step -> Octave -> Pitch
mkPitch :: Step -> Octave -> Pitch
mkPitch Step
a Octave
c = Step -> Maybe Semitones -> Octave -> Pitch
Pitch Step
a Maybe Semitones
forall a. Maybe a
Nothing Octave
c

-- | @pitched@ /(complex)/
--
-- The pitched-value type represents pictograms for pitched percussion instruments. The smufl attribute is used to distinguish different SMuFL glyphs for a particular pictogram within the tuned mallet percussion pictograms range.
data Pitched = 
      Pitched {
          Pitched -> PitchedValue
pitchedPitchedValue :: PitchedValue -- ^ text content
        , Pitched -> Maybe SmuflPictogramGlyphName
pitchedSmufl :: (Maybe SmuflPictogramGlyphName) -- ^ /smufl/ attribute
       }
    deriving (Pitched -> Pitched -> Bool
(Pitched -> Pitched -> Bool)
-> (Pitched -> Pitched -> Bool) -> Eq Pitched
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitched -> Pitched -> Bool
$c/= :: Pitched -> Pitched -> Bool
== :: Pitched -> Pitched -> Bool
$c== :: Pitched -> Pitched -> Bool
Eq,Typeable,(forall x. Pitched -> Rep Pitched x)
-> (forall x. Rep Pitched x -> Pitched) -> Generic Pitched
forall x. Rep Pitched x -> Pitched
forall x. Pitched -> Rep Pitched x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pitched x -> Pitched
$cfrom :: forall x. Pitched -> Rep Pitched x
Generic,Int -> Pitched -> ShowS
[Pitched] -> ShowS
Pitched -> String
(Int -> Pitched -> ShowS)
-> (Pitched -> String) -> ([Pitched] -> ShowS) -> Show Pitched
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitched] -> ShowS
$cshowList :: [Pitched] -> ShowS
show :: Pitched -> String
$cshow :: Pitched -> String
showsPrec :: Int -> Pitched -> ShowS
$cshowsPrec :: Int -> Pitched -> ShowS
Show)
instance EmitXml Pitched where
    emitXml :: Pitched -> XmlRep
emitXml (Pitched PitchedValue
a Maybe SmuflPictogramGlyphName
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (PitchedValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PitchedValue
a)
        ([XmlRep
-> (SmuflPictogramGlyphName -> XmlRep)
-> Maybe SmuflPictogramGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflPictogramGlyphName -> XmlRep)
-> SmuflPictogramGlyphName
-> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflPictogramGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflPictogramGlyphName
b])
        []
parsePitched :: P.XParse Pitched
parsePitched :: XParse Pitched
parsePitched = 
      PitchedValue -> Maybe SmuflPictogramGlyphName -> Pitched
Pitched
        (PitchedValue -> Maybe SmuflPictogramGlyphName -> Pitched)
-> XParse PitchedValue
-> XParse (Maybe SmuflPictogramGlyphName -> Pitched)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse PitchedValue) -> XParse PitchedValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PitchedValue
parsePitchedValue)
        XParse (Maybe SmuflPictogramGlyphName -> Pitched)
-> XParse (Maybe SmuflPictogramGlyphName) -> XParse Pitched
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflPictogramGlyphName
-> XParse (Maybe SmuflPictogramGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflPictogramGlyphName)
-> XParse SmuflPictogramGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflPictogramGlyphName
parseSmuflPictogramGlyphName)

-- | Smart constructor for 'Pitched'
mkPitched :: PitchedValue -> Pitched
mkPitched :: PitchedValue -> Pitched
mkPitched PitchedValue
a = PitchedValue -> Maybe SmuflPictogramGlyphName -> Pitched
Pitched PitchedValue
a Maybe SmuflPictogramGlyphName
forall a. Maybe a
Nothing

-- | @placement-text@ /(complex)/
--
-- The placement-text type represents a text element with print-style and placement attribute groups.
data PlacementText = 
      PlacementText {
          PlacementText -> String
placementTextString :: String -- ^ text content
        , PlacementText -> Maybe Tenths
placementTextDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , PlacementText -> Maybe Tenths
placementTextDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , PlacementText -> Maybe Tenths
placementTextRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , PlacementText -> Maybe Tenths
placementTextRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , PlacementText -> Maybe CommaSeparatedText
placementTextFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , PlacementText -> Maybe FontStyle
placementTextFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , PlacementText -> Maybe FontSize
placementTextFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , PlacementText -> Maybe FontWeight
placementTextFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , PlacementText -> Maybe Color
placementTextColor :: (Maybe Color) -- ^ /color/ attribute
        , PlacementText -> Maybe AboveBelow
placementTextPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (PlacementText -> PlacementText -> Bool
(PlacementText -> PlacementText -> Bool)
-> (PlacementText -> PlacementText -> Bool) -> Eq PlacementText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlacementText -> PlacementText -> Bool
$c/= :: PlacementText -> PlacementText -> Bool
== :: PlacementText -> PlacementText -> Bool
$c== :: PlacementText -> PlacementText -> Bool
Eq,Typeable,(forall x. PlacementText -> Rep PlacementText x)
-> (forall x. Rep PlacementText x -> PlacementText)
-> Generic PlacementText
forall x. Rep PlacementText x -> PlacementText
forall x. PlacementText -> Rep PlacementText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlacementText x -> PlacementText
$cfrom :: forall x. PlacementText -> Rep PlacementText x
Generic,Int -> PlacementText -> ShowS
[PlacementText] -> ShowS
PlacementText -> String
(Int -> PlacementText -> ShowS)
-> (PlacementText -> String)
-> ([PlacementText] -> ShowS)
-> Show PlacementText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlacementText] -> ShowS
$cshowList :: [PlacementText] -> ShowS
show :: PlacementText -> String
$cshow :: PlacementText -> String
showsPrec :: Int -> PlacementText -> ShowS
$cshowsPrec :: Int -> PlacementText -> ShowS
Show)
instance EmitXml PlacementText where
    emitXml :: PlacementText -> XmlRep
emitXml (PlacementText String
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        []
parsePlacementText :: P.XParse PlacementText
parsePlacementText :: XParse PlacementText
parsePlacementText = 
      String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> PlacementText
PlacementText
        (String
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> PlacementText)
-> XParse String
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> PlacementText)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color -> Maybe AboveBelow -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color -> Maybe AboveBelow -> PlacementText)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> PlacementText)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> PlacementText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> PlacementText)
-> XParse (Maybe AboveBelow) -> XParse PlacementText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'PlacementText'
mkPlacementText :: String -> PlacementText
mkPlacementText :: String -> PlacementText
mkPlacementText String
a = String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> PlacementText
PlacementText String
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @play@ /(complex)/
--
-- The play type, new in Version 3.0, specifies playback techniques to be used in conjunction with the instrument-sound element. When used as part of a sound element, it applies to all notes going forward in score order. In multi-instrument parts, the affected instrument should be specified using the id attribute. When used as part of a note element, it applies to the current note only.
data Play = 
      Play {
          Play -> Maybe IDREF
playId :: (Maybe IDREF) -- ^ /id/ attribute
        , Play -> [ChxPlay]
playPlay :: [ChxPlay]
       }
    deriving (Play -> Play -> Bool
(Play -> Play -> Bool) -> (Play -> Play -> Bool) -> Eq Play
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Play -> Play -> Bool
$c/= :: Play -> Play -> Bool
== :: Play -> Play -> Bool
$c== :: Play -> Play -> Bool
Eq,Typeable,(forall x. Play -> Rep Play x)
-> (forall x. Rep Play x -> Play) -> Generic Play
forall x. Rep Play x -> Play
forall x. Play -> Rep Play x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Play x -> Play
$cfrom :: forall x. Play -> Rep Play x
Generic,Int -> Play -> ShowS
[Play] -> ShowS
Play -> String
(Int -> Play -> ShowS)
-> (Play -> String) -> ([Play] -> ShowS) -> Show Play
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Play] -> ShowS
$cshowList :: [Play] -> ShowS
show :: Play -> String
$cshow :: Play -> String
showsPrec :: Int -> Play -> ShowS
$cshowsPrec :: Int -> Play -> ShowS
Show)
instance EmitXml Play where
    emitXml :: Play -> XmlRep
emitXml (Play Maybe IDREF
a [ChxPlay]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (IDREF -> XmlRep) -> Maybe IDREF -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (IDREF -> XmlRep) -> IDREF -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.IDREF -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe IDREF
a])
        ([[ChxPlay] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxPlay]
b])
parsePlay :: P.XParse Play
parsePlay :: XParse Play
parsePlay = 
      Maybe IDREF -> [ChxPlay] -> Play
Play
        (Maybe IDREF -> [ChxPlay] -> Play)
-> XParse (Maybe IDREF) -> XParse ([ChxPlay] -> Play)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse IDREF -> XParse (Maybe IDREF)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse IDREF) -> XParse IDREF
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse IDREF
parseIDREF)
        XParse ([ChxPlay] -> Play) -> XParse [ChxPlay] -> XParse Play
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxPlay -> XParse [ChxPlay]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxPlay
parseChxPlay)

-- | Smart constructor for 'Play'
mkPlay :: Play
mkPlay :: Play
mkPlay = Maybe IDREF -> [ChxPlay] -> Play
Play Maybe IDREF
forall a. Maybe a
Nothing []

-- | @principal-voice@ /(complex)/
--
-- The principal-voice element represents principal and secondary voices in a score, either for analysis or for square bracket symbols that appear in a score. The symbol attribute indicates the type of symbol used at the start of the principal-voice. The content of the principal-voice element is used for analysis and may be any text value. When used for analysis separate from any printed score markings, the symbol attribute should be set to "none".
data PrincipalVoice = 
      PrincipalVoice {
          PrincipalVoice -> String
principalVoiceString :: String -- ^ text content
        , PrincipalVoice -> StartStop
principalVoiceType :: StartStop -- ^ /type/ attribute
        , PrincipalVoice -> PrincipalVoiceSymbol
principalVoiceSymbol :: PrincipalVoiceSymbol -- ^ /symbol/ attribute
        , PrincipalVoice -> Maybe Tenths
principalVoiceDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , PrincipalVoice -> Maybe Tenths
principalVoiceDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , PrincipalVoice -> Maybe Tenths
principalVoiceRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , PrincipalVoice -> Maybe Tenths
principalVoiceRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , PrincipalVoice -> Maybe CommaSeparatedText
principalVoiceFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , PrincipalVoice -> Maybe FontStyle
principalVoiceFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , PrincipalVoice -> Maybe FontSize
principalVoiceFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , PrincipalVoice -> Maybe FontWeight
principalVoiceFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , PrincipalVoice -> Maybe Color
principalVoiceColor :: (Maybe Color) -- ^ /color/ attribute
        , PrincipalVoice -> Maybe LeftCenterRight
principalVoiceHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , PrincipalVoice -> Maybe Valign
principalVoiceValign :: (Maybe Valign) -- ^ /valign/ attribute
        , PrincipalVoice -> Maybe ID
principalVoiceId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (PrincipalVoice -> PrincipalVoice -> Bool
(PrincipalVoice -> PrincipalVoice -> Bool)
-> (PrincipalVoice -> PrincipalVoice -> Bool) -> Eq PrincipalVoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrincipalVoice -> PrincipalVoice -> Bool
$c/= :: PrincipalVoice -> PrincipalVoice -> Bool
== :: PrincipalVoice -> PrincipalVoice -> Bool
$c== :: PrincipalVoice -> PrincipalVoice -> Bool
Eq,Typeable,(forall x. PrincipalVoice -> Rep PrincipalVoice x)
-> (forall x. Rep PrincipalVoice x -> PrincipalVoice)
-> Generic PrincipalVoice
forall x. Rep PrincipalVoice x -> PrincipalVoice
forall x. PrincipalVoice -> Rep PrincipalVoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrincipalVoice x -> PrincipalVoice
$cfrom :: forall x. PrincipalVoice -> Rep PrincipalVoice x
Generic,Int -> PrincipalVoice -> ShowS
[PrincipalVoice] -> ShowS
PrincipalVoice -> String
(Int -> PrincipalVoice -> ShowS)
-> (PrincipalVoice -> String)
-> ([PrincipalVoice] -> ShowS)
-> Show PrincipalVoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrincipalVoice] -> ShowS
$cshowList :: [PrincipalVoice] -> ShowS
show :: PrincipalVoice -> String
$cshow :: PrincipalVoice -> String
showsPrec :: Int -> PrincipalVoice -> ShowS
$cshowsPrec :: Int -> PrincipalVoice -> ShowS
Show)
instance EmitXml PrincipalVoice where
    emitXml :: PrincipalVoice -> XmlRep
emitXml (PrincipalVoice String
a StartStop
b PrincipalVoiceSymbol
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l Maybe LeftCenterRight
m Maybe Valign
n Maybe ID
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"symbol" Maybe String
forall a. Maybe a
Nothing) (PrincipalVoiceSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PrincipalVoiceSymbol
c)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
o])
        []
parsePrincipalVoice :: P.XParse PrincipalVoice
parsePrincipalVoice :: XParse PrincipalVoice
parsePrincipalVoice = 
      String
-> StartStop
-> PrincipalVoiceSymbol
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> PrincipalVoice
PrincipalVoice
        (String
 -> StartStop
 -> PrincipalVoiceSymbol
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> PrincipalVoice)
-> XParse String
-> XParse
     (StartStop
      -> PrincipalVoiceSymbol
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (StartStop
   -> PrincipalVoiceSymbol
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse StartStop
-> XParse
     (PrincipalVoiceSymbol
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (PrincipalVoiceSymbol
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse PrincipalVoiceSymbol
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"symbol") XParse String
-> (String -> XParse PrincipalVoiceSymbol)
-> XParse PrincipalVoiceSymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PrincipalVoiceSymbol
parsePrincipalVoiceSymbol)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> PrincipalVoice)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign -> Maybe ID -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign -> Maybe ID -> PrincipalVoice)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> PrincipalVoice)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> PrincipalVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> PrincipalVoice)
-> XParse (Maybe ID) -> XParse PrincipalVoice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'PrincipalVoice'
mkPrincipalVoice :: String -> StartStop -> PrincipalVoiceSymbol -> PrincipalVoice
mkPrincipalVoice :: String -> StartStop -> PrincipalVoiceSymbol -> PrincipalVoice
mkPrincipalVoice String
a StartStop
b PrincipalVoiceSymbol
c = String
-> StartStop
-> PrincipalVoiceSymbol
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> PrincipalVoice
PrincipalVoice String
a StartStop
b PrincipalVoiceSymbol
c Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @print@ /(complex)/
--
-- The print type contains general printing parameters, including the layout elements defined in the layout.mod file. The part-name-display and part-abbreviation-display elements used in the score.mod file may also be used here to change how a part name or abbreviation is displayed over the course of a piece. They take effect when the current measure or a succeeding measure starts a new system.
-- 
-- Layout elements in a print statement only apply to the current page, system, staff, or measure. Music that follows continues to take the default values from the layout included in the defaults element.
data Print = 
      Print {
          Print -> Maybe Tenths
printStaffSpacing :: (Maybe Tenths) -- ^ /staff-spacing/ attribute
        , Print -> Maybe YesNo
printNewSystem :: (Maybe YesNo) -- ^ /new-system/ attribute
        , Print -> Maybe YesNo
printNewPage :: (Maybe YesNo) -- ^ /new-page/ attribute
        , Print -> Maybe PositiveInteger
printBlankPage :: (Maybe PositiveInteger) -- ^ /blank-page/ attribute
        , Print -> Maybe Token
printPageNumber :: (Maybe Token) -- ^ /page-number/ attribute
        , Print -> Maybe ID
printId :: (Maybe ID) -- ^ /id/ attribute
        , Print -> Layout
printLayout :: Layout
        , Print -> Maybe MeasureLayout
printMeasureLayout :: (Maybe MeasureLayout) -- ^ /measure-layout/ child element
        , Print -> Maybe MeasureNumbering
printMeasureNumbering :: (Maybe MeasureNumbering) -- ^ /measure-numbering/ child element
        , Print -> Maybe NameDisplay
printPartNameDisplay :: (Maybe NameDisplay) -- ^ /part-name-display/ child element
        , Print -> Maybe NameDisplay
printPartAbbreviationDisplay :: (Maybe NameDisplay) -- ^ /part-abbreviation-display/ child element
       }
    deriving (Print -> Print -> Bool
(Print -> Print -> Bool) -> (Print -> Print -> Bool) -> Eq Print
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Print -> Print -> Bool
$c/= :: Print -> Print -> Bool
== :: Print -> Print -> Bool
$c== :: Print -> Print -> Bool
Eq,Typeable,(forall x. Print -> Rep Print x)
-> (forall x. Rep Print x -> Print) -> Generic Print
forall x. Rep Print x -> Print
forall x. Print -> Rep Print x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Print x -> Print
$cfrom :: forall x. Print -> Rep Print x
Generic,Int -> Print -> ShowS
[Print] -> ShowS
Print -> String
(Int -> Print -> ShowS)
-> (Print -> String) -> ([Print] -> ShowS) -> Show Print
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Print] -> ShowS
$cshowList :: [Print] -> ShowS
show :: Print -> String
$cshow :: Print -> String
showsPrec :: Int -> Print -> ShowS
$cshowsPrec :: Int -> Print -> ShowS
Show)
instance EmitXml Print where
    emitXml :: Print -> XmlRep
emitXml (Print Maybe Tenths
a Maybe YesNo
b Maybe YesNo
c Maybe PositiveInteger
d Maybe Token
e Maybe ID
f Layout
g Maybe MeasureLayout
h Maybe MeasureNumbering
i Maybe NameDisplay
j Maybe NameDisplay
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"staff-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"new-system" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"new-page" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (PositiveInteger -> XmlRep) -> Maybe PositiveInteger -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"blank-page" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PositiveInteger -> XmlRep) -> PositiveInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PositiveInteger
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"page-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
f])
        ([Layout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Layout
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MeasureLayout -> XmlRep) -> Maybe MeasureLayout -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure-layout" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MeasureLayout -> XmlRep) -> MeasureLayout -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MeasureLayout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MeasureLayout
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MeasureNumbering -> XmlRep) -> Maybe MeasureNumbering -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure-numbering" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MeasureNumbering -> XmlRep) -> MeasureNumbering -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MeasureNumbering -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MeasureNumbering
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-name-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-abbreviation-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
k])
parsePrint :: P.XParse Print
parsePrint :: XParse Print
parsePrint = 
      Maybe Tenths
-> Maybe YesNo
-> Maybe YesNo
-> Maybe PositiveInteger
-> Maybe Token
-> Maybe ID
-> Layout
-> Maybe MeasureLayout
-> Maybe MeasureNumbering
-> Maybe NameDisplay
-> Maybe NameDisplay
-> Print
Print
        (Maybe Tenths
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe PositiveInteger
 -> Maybe Token
 -> Maybe ID
 -> Layout
 -> Maybe MeasureLayout
 -> Maybe MeasureNumbering
 -> Maybe NameDisplay
 -> Maybe NameDisplay
 -> Print)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe PositiveInteger
      -> Maybe Token
      -> Maybe ID
      -> Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"staff-spacing") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe PositiveInteger
   -> Maybe Token
   -> Maybe ID
   -> Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe PositiveInteger
      -> Maybe Token
      -> Maybe ID
      -> Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"new-system") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe PositiveInteger
   -> Maybe Token
   -> Maybe ID
   -> Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe PositiveInteger
      -> Maybe Token
      -> Maybe ID
      -> Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"new-page") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe PositiveInteger
   -> Maybe Token
   -> Maybe ID
   -> Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe PositiveInteger)
-> XParse
     (Maybe Token
      -> Maybe ID
      -> Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PositiveInteger -> XParse (Maybe PositiveInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"blank-page") XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger)
        XParse
  (Maybe Token
   -> Maybe ID
   -> Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe Token)
-> XParse
     (Maybe ID
      -> Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"page-number") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe ID
   -> Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe ID)
-> XParse
     (Layout
      -> Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Layout
   -> Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse Layout
-> XParse
     (Maybe MeasureLayout
      -> Maybe MeasureNumbering
      -> Maybe NameDisplay
      -> Maybe NameDisplay
      -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Layout
parseLayout
        XParse
  (Maybe MeasureLayout
   -> Maybe MeasureNumbering
   -> Maybe NameDisplay
   -> Maybe NameDisplay
   -> Print)
-> XParse (Maybe MeasureLayout)
-> XParse
     (Maybe MeasureNumbering
      -> Maybe NameDisplay -> Maybe NameDisplay -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MeasureLayout -> XParse (Maybe MeasureLayout)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MeasureLayout -> XParse MeasureLayout
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure-layout") (XParse MeasureLayout
parseMeasureLayout))
        XParse
  (Maybe MeasureNumbering
   -> Maybe NameDisplay -> Maybe NameDisplay -> Print)
-> XParse (Maybe MeasureNumbering)
-> XParse (Maybe NameDisplay -> Maybe NameDisplay -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MeasureNumbering -> XParse (Maybe MeasureNumbering)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MeasureNumbering -> XParse MeasureNumbering
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure-numbering") (XParse MeasureNumbering
parseMeasureNumbering))
        XParse (Maybe NameDisplay -> Maybe NameDisplay -> Print)
-> XParse (Maybe NameDisplay)
-> XParse (Maybe NameDisplay -> Print)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-name-display") (XParse NameDisplay
parseNameDisplay))
        XParse (Maybe NameDisplay -> Print)
-> XParse (Maybe NameDisplay) -> XParse Print
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-abbreviation-display") (XParse NameDisplay
parseNameDisplay))

-- | Smart constructor for 'Print'
mkPrint :: Layout -> Print
mkPrint :: Layout -> Print
mkPrint Layout
g = Maybe Tenths
-> Maybe YesNo
-> Maybe YesNo
-> Maybe PositiveInteger
-> Maybe Token
-> Maybe ID
-> Layout
-> Maybe MeasureLayout
-> Maybe MeasureNumbering
-> Maybe NameDisplay
-> Maybe NameDisplay
-> Print
Print Maybe Tenths
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe PositiveInteger
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Layout
g Maybe MeasureLayout
forall a. Maybe a
Nothing Maybe MeasureNumbering
forall a. Maybe a
Nothing Maybe NameDisplay
forall a. Maybe a
Nothing Maybe NameDisplay
forall a. Maybe a
Nothing

-- | @repeat@ /(complex)/
--
-- The repeat type represents repeat marks. The start of the repeat has a forward direction while the end of the repeat has a backward direction. Backward repeats that are not part of an ending can use the times attribute to indicate the number of times the repeated section is played.
data Repeat = 
      Repeat {
          Repeat -> BackwardForward
repeatDirection :: BackwardForward -- ^ /direction/ attribute
        , Repeat -> Maybe NonNegativeInteger
repeatTimes :: (Maybe NonNegativeInteger) -- ^ /times/ attribute
        , Repeat -> Maybe Winged
repeatWinged :: (Maybe Winged) -- ^ /winged/ attribute
       }
    deriving (Repeat -> Repeat -> Bool
(Repeat -> Repeat -> Bool)
-> (Repeat -> Repeat -> Bool) -> Eq Repeat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repeat -> Repeat -> Bool
$c/= :: Repeat -> Repeat -> Bool
== :: Repeat -> Repeat -> Bool
$c== :: Repeat -> Repeat -> Bool
Eq,Typeable,(forall x. Repeat -> Rep Repeat x)
-> (forall x. Rep Repeat x -> Repeat) -> Generic Repeat
forall x. Rep Repeat x -> Repeat
forall x. Repeat -> Rep Repeat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repeat x -> Repeat
$cfrom :: forall x. Repeat -> Rep Repeat x
Generic,Int -> Repeat -> ShowS
[Repeat] -> ShowS
Repeat -> String
(Int -> Repeat -> ShowS)
-> (Repeat -> String) -> ([Repeat] -> ShowS) -> Show Repeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repeat] -> ShowS
$cshowList :: [Repeat] -> ShowS
show :: Repeat -> String
$cshow :: Repeat -> String
showsPrec :: Int -> Repeat -> ShowS
$cshowsPrec :: Int -> Repeat -> ShowS
Show)
instance EmitXml Repeat where
    emitXml :: Repeat -> XmlRep
emitXml (Repeat BackwardForward
a Maybe NonNegativeInteger
b Maybe Winged
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"direction" Maybe String
forall a. Maybe a
Nothing) (BackwardForward -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BackwardForward
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeInteger -> XmlRep)
-> Maybe NonNegativeInteger
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"times" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeInteger -> XmlRep) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeInteger
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Winged -> XmlRep) -> Maybe Winged -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"winged" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Winged -> XmlRep) -> Winged -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Winged -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Winged
c])
        []
parseRepeat :: P.XParse Repeat
parseRepeat :: XParse Repeat
parseRepeat = 
      BackwardForward
-> Maybe NonNegativeInteger -> Maybe Winged -> Repeat
Repeat
        (BackwardForward
 -> Maybe NonNegativeInteger -> Maybe Winged -> Repeat)
-> XParse BackwardForward
-> XParse (Maybe NonNegativeInteger -> Maybe Winged -> Repeat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"direction") XParse String
-> (String -> XParse BackwardForward) -> XParse BackwardForward
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse BackwardForward
parseBackwardForward)
        XParse (Maybe NonNegativeInteger -> Maybe Winged -> Repeat)
-> XParse (Maybe NonNegativeInteger)
-> XParse (Maybe Winged -> Repeat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeInteger -> XParse (Maybe NonNegativeInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"times") XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger)
        XParse (Maybe Winged -> Repeat)
-> XParse (Maybe Winged) -> XParse Repeat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Winged -> XParse (Maybe Winged)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"winged") XParse String -> (String -> XParse Winged) -> XParse Winged
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Winged
parseWinged)

-- | Smart constructor for 'Repeat'
mkRepeat :: BackwardForward -> Repeat
mkRepeat :: BackwardForward -> Repeat
mkRepeat BackwardForward
a = BackwardForward
-> Maybe NonNegativeInteger -> Maybe Winged -> Repeat
Repeat BackwardForward
a Maybe NonNegativeInteger
forall a. Maybe a
Nothing Maybe Winged
forall a. Maybe a
Nothing

-- | @rest@ /(complex)/
--
-- The rest element indicates notated rests or silences. Rest elements are usually empty, but placement on the staff can be specified using display-step and display-octave elements. If the measure attribute is set to yes, this indicates this is a complete measure rest.
data Rest = 
      Rest {
          Rest -> Maybe YesNo
restMeasure :: (Maybe YesNo) -- ^ /measure/ attribute
        , Rest -> Maybe DisplayStepOctave
restDisplayStepOctave :: (Maybe DisplayStepOctave)
       }
    deriving (Rest -> Rest -> Bool
(Rest -> Rest -> Bool) -> (Rest -> Rest -> Bool) -> Eq Rest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rest -> Rest -> Bool
$c/= :: Rest -> Rest -> Bool
== :: Rest -> Rest -> Bool
$c== :: Rest -> Rest -> Bool
Eq,Typeable,(forall x. Rest -> Rep Rest x)
-> (forall x. Rep Rest x -> Rest) -> Generic Rest
forall x. Rep Rest x -> Rest
forall x. Rest -> Rep Rest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rest x -> Rest
$cfrom :: forall x. Rest -> Rep Rest x
Generic,Int -> Rest -> ShowS
[Rest] -> ShowS
Rest -> String
(Int -> Rest -> ShowS)
-> (Rest -> String) -> ([Rest] -> ShowS) -> Show Rest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rest] -> ShowS
$cshowList :: [Rest] -> ShowS
show :: Rest -> String
$cshow :: Rest -> String
showsPrec :: Int -> Rest -> ShowS
$cshowsPrec :: Int -> Rest -> ShowS
Show)
instance EmitXml Rest where
    emitXml :: Rest -> XmlRep
emitXml (Rest Maybe YesNo
a Maybe DisplayStepOctave
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"measure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
a])
        ([Maybe DisplayStepOctave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe DisplayStepOctave
b])
parseRest :: P.XParse Rest
parseRest :: XParse Rest
parseRest = 
      Maybe YesNo -> Maybe DisplayStepOctave -> Rest
Rest
        (Maybe YesNo -> Maybe DisplayStepOctave -> Rest)
-> XParse (Maybe YesNo) -> XParse (Maybe DisplayStepOctave -> Rest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"measure") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe DisplayStepOctave -> Rest)
-> XParse (Maybe DisplayStepOctave) -> XParse Rest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse DisplayStepOctave -> XParse (Maybe DisplayStepOctave)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse DisplayStepOctave
parseDisplayStepOctave)

-- | Smart constructor for 'Rest'
mkRest :: Rest
mkRest :: Rest
mkRest = Maybe YesNo -> Maybe DisplayStepOctave -> Rest
Rest Maybe YesNo
forall a. Maybe a
Nothing Maybe DisplayStepOctave
forall a. Maybe a
Nothing

-- | @root@ /(complex)/
--
-- The root type indicates a pitch like C, D, E vs. a function indication like I, II, III. It is used with chord symbols in popular music. The root element has a root-step and optional root-alter element similar to the step and alter elements, but renamed to distinguish the different musical meanings.
data Root = 
      Root {
          Root -> RootStep
rootRootStep :: RootStep -- ^ /root-step/ child element
        , Root -> Maybe RootAlter
rootRootAlter :: (Maybe RootAlter) -- ^ /root-alter/ child element
       }
    deriving (Root -> Root -> Bool
(Root -> Root -> Bool) -> (Root -> Root -> Bool) -> Eq Root
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Root -> Root -> Bool
$c/= :: Root -> Root -> Bool
== :: Root -> Root -> Bool
$c== :: Root -> Root -> Bool
Eq,Typeable,(forall x. Root -> Rep Root x)
-> (forall x. Rep Root x -> Root) -> Generic Root
forall x. Rep Root x -> Root
forall x. Root -> Rep Root x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Root x -> Root
$cfrom :: forall x. Root -> Rep Root x
Generic,Int -> Root -> ShowS
[Root] -> ShowS
Root -> String
(Int -> Root -> ShowS)
-> (Root -> String) -> ([Root] -> ShowS) -> Show Root
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Root] -> ShowS
$cshowList :: [Root] -> ShowS
show :: Root -> String
$cshow :: Root -> String
showsPrec :: Int -> Root -> ShowS
$cshowsPrec :: Int -> Root -> ShowS
Show)
instance EmitXml Root where
    emitXml :: Root -> XmlRep
emitXml (Root RootStep
a Maybe RootAlter
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"root-step" Maybe String
forall a. Maybe a
Nothing) (RootStep -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml RootStep
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (RootAlter -> XmlRep) -> Maybe RootAlter -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"root-alter" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (RootAlter -> XmlRep) -> RootAlter -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RootAlter -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RootAlter
b])
parseRoot :: P.XParse Root
parseRoot :: XParse Root
parseRoot = 
      RootStep -> Maybe RootAlter -> Root
Root
        (RootStep -> Maybe RootAlter -> Root)
-> XParse RootStep -> XParse (Maybe RootAlter -> Root)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse RootStep -> XParse RootStep
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"root-step") (XParse RootStep
parseRootStep))
        XParse (Maybe RootAlter -> Root)
-> XParse (Maybe RootAlter) -> XParse Root
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RootAlter -> XParse (Maybe RootAlter)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse RootAlter -> XParse RootAlter
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"root-alter") (XParse RootAlter
parseRootAlter))

-- | Smart constructor for 'Root'
mkRoot :: RootStep -> Root
mkRoot :: RootStep -> Root
mkRoot RootStep
a = RootStep -> Maybe RootAlter -> Root
Root RootStep
a Maybe RootAlter
forall a. Maybe a
Nothing

-- | @root-alter@ /(complex)/
--
-- The root-alter type represents the chromatic alteration of the root of the current chord within the harmony element. In some chord styles, the text for the root-step element may include root-alter information. In that case, the print-object attribute of the root-alter element can be set to no. The location attribute indicates whether the alteration should appear to the left or the right of the root-step; it is right by default.
data RootAlter = 
      RootAlter {
          RootAlter -> Semitones
rootAlterSemitones :: Semitones -- ^ text content
        , RootAlter -> Maybe LeftRight
rootAlterLocation :: (Maybe LeftRight) -- ^ /location/ attribute
        , RootAlter -> Maybe YesNo
rootAlterPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , RootAlter -> Maybe Tenths
rootAlterDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , RootAlter -> Maybe Tenths
rootAlterDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , RootAlter -> Maybe Tenths
rootAlterRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , RootAlter -> Maybe Tenths
rootAlterRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , RootAlter -> Maybe CommaSeparatedText
rootAlterFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , RootAlter -> Maybe FontStyle
rootAlterFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , RootAlter -> Maybe FontSize
rootAlterFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , RootAlter -> Maybe FontWeight
rootAlterFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , RootAlter -> Maybe Color
rootAlterColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (RootAlter -> RootAlter -> Bool
(RootAlter -> RootAlter -> Bool)
-> (RootAlter -> RootAlter -> Bool) -> Eq RootAlter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootAlter -> RootAlter -> Bool
$c/= :: RootAlter -> RootAlter -> Bool
== :: RootAlter -> RootAlter -> Bool
$c== :: RootAlter -> RootAlter -> Bool
Eq,Typeable,(forall x. RootAlter -> Rep RootAlter x)
-> (forall x. Rep RootAlter x -> RootAlter) -> Generic RootAlter
forall x. Rep RootAlter x -> RootAlter
forall x. RootAlter -> Rep RootAlter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RootAlter x -> RootAlter
$cfrom :: forall x. RootAlter -> Rep RootAlter x
Generic,Int -> RootAlter -> ShowS
[RootAlter] -> ShowS
RootAlter -> String
(Int -> RootAlter -> ShowS)
-> (RootAlter -> String)
-> ([RootAlter] -> ShowS)
-> Show RootAlter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootAlter] -> ShowS
$cshowList :: [RootAlter] -> ShowS
show :: RootAlter -> String
$cshow :: RootAlter -> String
showsPrec :: Int -> RootAlter -> ShowS
$cshowsPrec :: Int -> RootAlter -> ShowS
Show)
instance EmitXml RootAlter where
    emitXml :: RootAlter -> XmlRep
emitXml (RootAlter Semitones
a Maybe LeftRight
b Maybe YesNo
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
a)
        ([XmlRep -> (LeftRight -> XmlRep) -> Maybe LeftRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"location" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LeftRight -> XmlRep) -> LeftRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftRight
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l])
        []
parseRootAlter :: P.XParse RootAlter
parseRootAlter :: XParse RootAlter
parseRootAlter = 
      Semitones
-> Maybe LeftRight
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> RootAlter
RootAlter
        (Semitones
 -> Maybe LeftRight
 -> Maybe YesNo
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> RootAlter)
-> XParse Semitones
-> XParse
     (Maybe LeftRight
      -> Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones)
        XParse
  (Maybe LeftRight
   -> Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe LeftRight)
-> XParse
     (Maybe YesNo
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftRight -> XParse (Maybe LeftRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"location") XParse String -> (String -> XParse LeftRight) -> XParse LeftRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftRight
parseLeftRight)
        XParse
  (Maybe YesNo
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootAlter)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootAlter)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootAlter)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> RootAlter)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> RootAlter)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> RootAlter)
-> XParse (Maybe Color) -> XParse RootAlter
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'RootAlter'
mkRootAlter :: Semitones -> RootAlter
mkRootAlter :: Semitones -> RootAlter
mkRootAlter Semitones
a = Semitones
-> Maybe LeftRight
-> Maybe YesNo
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> RootAlter
RootAlter Semitones
a Maybe LeftRight
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @root-step@ /(complex)/
--
-- The root-step type represents the pitch step of the root of the current chord within the harmony element. The text attribute indicates how the root should appear in a score if not using the element contents.
data RootStep = 
      RootStep {
          RootStep -> Step
rootStepStep :: Step -- ^ text content
        , RootStep -> Maybe Token
rootStepText :: (Maybe Token) -- ^ /text/ attribute
        , RootStep -> Maybe Tenths
rootStepDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , RootStep -> Maybe Tenths
rootStepDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , RootStep -> Maybe Tenths
rootStepRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , RootStep -> Maybe Tenths
rootStepRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , RootStep -> Maybe CommaSeparatedText
rootStepFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , RootStep -> Maybe FontStyle
rootStepFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , RootStep -> Maybe FontSize
rootStepFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , RootStep -> Maybe FontWeight
rootStepFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , RootStep -> Maybe Color
rootStepColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (RootStep -> RootStep -> Bool
(RootStep -> RootStep -> Bool)
-> (RootStep -> RootStep -> Bool) -> Eq RootStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RootStep -> RootStep -> Bool
$c/= :: RootStep -> RootStep -> Bool
== :: RootStep -> RootStep -> Bool
$c== :: RootStep -> RootStep -> Bool
Eq,Typeable,(forall x. RootStep -> Rep RootStep x)
-> (forall x. Rep RootStep x -> RootStep) -> Generic RootStep
forall x. Rep RootStep x -> RootStep
forall x. RootStep -> Rep RootStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RootStep x -> RootStep
$cfrom :: forall x. RootStep -> Rep RootStep x
Generic,Int -> RootStep -> ShowS
[RootStep] -> ShowS
RootStep -> String
(Int -> RootStep -> ShowS)
-> (RootStep -> String) -> ([RootStep] -> ShowS) -> Show RootStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RootStep] -> ShowS
$cshowList :: [RootStep] -> ShowS
show :: RootStep -> String
$cshow :: RootStep -> String
showsPrec :: Int -> RootStep -> ShowS
$cshowsPrec :: Int -> RootStep -> ShowS
Show)
instance EmitXml RootStep where
    emitXml :: RootStep -> XmlRep
emitXml (RootStep Step
a Maybe Token
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k])
        []
parseRootStep :: P.XParse RootStep
parseRootStep :: XParse RootStep
parseRootStep = 
      Step
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> RootStep
RootStep
        (Step
 -> Maybe Token
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> RootStep)
-> XParse Step
-> XParse
     (Maybe Token
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep)
        XParse
  (Maybe Token
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe Token)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"text") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> RootStep)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootStep)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> RootStep)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> RootStep)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> RootStep)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> RootStep)
-> XParse (Maybe Color) -> XParse RootStep
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'RootStep'
mkRootStep :: Step -> RootStep
mkRootStep :: Step -> RootStep
mkRootStep Step
a = Step
-> Maybe Token
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> RootStep
RootStep Step
a Maybe Token
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @scaling@ /(complex)/
--
-- Margins, page sizes, and distances are all measured in tenths to keep MusicXML data in a consistent coordinate system as much as possible. The translation to absolute units is done with the scaling type, which specifies how many millimeters are equal to how many tenths. For a staff height of 7 mm, millimeters would be set to 7 while tenths is set to 40. The ability to set a formula rather than a single scaling factor helps avoid roundoff errors.
data Scaling = 
      Scaling {
          Scaling -> Millimeters
scalingMillimeters :: Millimeters -- ^ /millimeters/ child element
        , Scaling -> Tenths
scalingTenths :: Tenths -- ^ /tenths/ child element
       }
    deriving (Scaling -> Scaling -> Bool
(Scaling -> Scaling -> Bool)
-> (Scaling -> Scaling -> Bool) -> Eq Scaling
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scaling -> Scaling -> Bool
$c/= :: Scaling -> Scaling -> Bool
== :: Scaling -> Scaling -> Bool
$c== :: Scaling -> Scaling -> Bool
Eq,Typeable,(forall x. Scaling -> Rep Scaling x)
-> (forall x. Rep Scaling x -> Scaling) -> Generic Scaling
forall x. Rep Scaling x -> Scaling
forall x. Scaling -> Rep Scaling x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scaling x -> Scaling
$cfrom :: forall x. Scaling -> Rep Scaling x
Generic,Int -> Scaling -> ShowS
[Scaling] -> ShowS
Scaling -> String
(Int -> Scaling -> ShowS)
-> (Scaling -> String) -> ([Scaling] -> ShowS) -> Show Scaling
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scaling] -> ShowS
$cshowList :: [Scaling] -> ShowS
show :: Scaling -> String
$cshow :: Scaling -> String
showsPrec :: Int -> Scaling -> ShowS
$cshowsPrec :: Int -> Scaling -> ShowS
Show)
instance EmitXml Scaling where
    emitXml :: Scaling -> XmlRep
emitXml (Scaling Millimeters
a Tenths
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"millimeters" Maybe String
forall a. Maybe a
Nothing) (Millimeters -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Millimeters
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tenths" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
b)])
parseScaling :: P.XParse Scaling
parseScaling :: XParse Scaling
parseScaling = 
      Millimeters -> Tenths -> Scaling
Scaling
        (Millimeters -> Tenths -> Scaling)
-> XParse Millimeters -> XParse (Tenths -> Scaling)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Millimeters -> XParse Millimeters
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"millimeters") (XParse String
P.xtext XParse String
-> (String -> XParse Millimeters) -> XParse Millimeters
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Millimeters
parseMillimeters))
        XParse (Tenths -> Scaling) -> XParse Tenths -> XParse Scaling
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tenths") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'Scaling'
mkScaling :: Millimeters -> Tenths -> Scaling
mkScaling :: Millimeters -> Tenths -> Scaling
mkScaling Millimeters
a Tenths
b = Millimeters -> Tenths -> Scaling
Scaling Millimeters
a Tenths
b

-- | @scordatura@ /(complex)/
--
-- Scordatura string tunings are represented by a series of accord elements, similar to the staff-tuning elements. Strings are numbered from high to low.
data Scordatura = 
      Scordatura {
          Scordatura -> Maybe ID
scordaturaId :: (Maybe ID) -- ^ /id/ attribute
        , Scordatura -> [Accord]
scordaturaAccord :: [Accord] -- ^ /accord/ child element
       }
    deriving (Scordatura -> Scordatura -> Bool
(Scordatura -> Scordatura -> Bool)
-> (Scordatura -> Scordatura -> Bool) -> Eq Scordatura
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scordatura -> Scordatura -> Bool
$c/= :: Scordatura -> Scordatura -> Bool
== :: Scordatura -> Scordatura -> Bool
$c== :: Scordatura -> Scordatura -> Bool
Eq,Typeable,(forall x. Scordatura -> Rep Scordatura x)
-> (forall x. Rep Scordatura x -> Scordatura) -> Generic Scordatura
forall x. Rep Scordatura x -> Scordatura
forall x. Scordatura -> Rep Scordatura x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scordatura x -> Scordatura
$cfrom :: forall x. Scordatura -> Rep Scordatura x
Generic,Int -> Scordatura -> ShowS
[Scordatura] -> ShowS
Scordatura -> String
(Int -> Scordatura -> ShowS)
-> (Scordatura -> String)
-> ([Scordatura] -> ShowS)
-> Show Scordatura
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scordatura] -> ShowS
$cshowList :: [Scordatura] -> ShowS
show :: Scordatura -> String
$cshow :: Scordatura -> String
showsPrec :: Int -> Scordatura -> ShowS
$cshowsPrec :: Int -> Scordatura -> ShowS
Show)
instance EmitXml Scordatura where
    emitXml :: Scordatura -> XmlRep
emitXml (Scordatura Maybe ID
a [Accord]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
a])
        ((Accord -> XmlRep) -> [Accord] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accord" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Accord -> XmlRep) -> Accord -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Accord -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Accord]
b)
parseScordatura :: P.XParse Scordatura
parseScordatura :: XParse Scordatura
parseScordatura = 
      Maybe ID -> [Accord] -> Scordatura
Scordatura
        (Maybe ID -> [Accord] -> Scordatura)
-> XParse (Maybe ID) -> XParse ([Accord] -> Scordatura)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([Accord] -> Scordatura)
-> XParse [Accord] -> XParse Scordatura
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Accord -> XParse [Accord]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Accord -> XParse Accord
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accord") (XParse Accord
parseAccord))

-- | Smart constructor for 'Scordatura'
mkScordatura :: Scordatura
mkScordatura :: Scordatura
mkScordatura = Maybe ID -> [Accord] -> Scordatura
Scordatura Maybe ID
forall a. Maybe a
Nothing []

-- | @score-instrument@ /(complex)/
--
-- The score-instrument type represents a single instrument within a score-part. As with the score-part type, each score-instrument has a required ID attribute, a name, and an optional abbreviation.
-- 
-- A score-instrument type is also required if the score specifies MIDI 1.0 channels, banks, or programs. An initial midi-instrument assignment can also be made here. MusicXML software should be able to automatically assign reasonable channels and instruments without these elements in simple cases, such as where part names match General MIDI instrument names.
data ScoreInstrument = 
      ScoreInstrument {
          ScoreInstrument -> ID
scoreInstrumentId :: ID -- ^ /id/ attribute
        , ScoreInstrument -> String
scoreInstrumentInstrumentName :: String -- ^ /instrument-name/ child element
        , ScoreInstrument -> Maybe String
scoreInstrumentInstrumentAbbreviation :: (Maybe String) -- ^ /instrument-abbreviation/ child element
        , ScoreInstrument -> Maybe String
scoreInstrumentInstrumentSound :: (Maybe String) -- ^ /instrument-sound/ child element
        , ScoreInstrument -> Maybe ChxScoreInstrument
scoreInstrumentScoreInstrument :: (Maybe ChxScoreInstrument)
        , ScoreInstrument -> Maybe VirtualInstrument
scoreInstrumentVirtualInstrument :: (Maybe VirtualInstrument) -- ^ /virtual-instrument/ child element
       }
    deriving (ScoreInstrument -> ScoreInstrument -> Bool
(ScoreInstrument -> ScoreInstrument -> Bool)
-> (ScoreInstrument -> ScoreInstrument -> Bool)
-> Eq ScoreInstrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreInstrument -> ScoreInstrument -> Bool
$c/= :: ScoreInstrument -> ScoreInstrument -> Bool
== :: ScoreInstrument -> ScoreInstrument -> Bool
$c== :: ScoreInstrument -> ScoreInstrument -> Bool
Eq,Typeable,(forall x. ScoreInstrument -> Rep ScoreInstrument x)
-> (forall x. Rep ScoreInstrument x -> ScoreInstrument)
-> Generic ScoreInstrument
forall x. Rep ScoreInstrument x -> ScoreInstrument
forall x. ScoreInstrument -> Rep ScoreInstrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScoreInstrument x -> ScoreInstrument
$cfrom :: forall x. ScoreInstrument -> Rep ScoreInstrument x
Generic,Int -> ScoreInstrument -> ShowS
[ScoreInstrument] -> ShowS
ScoreInstrument -> String
(Int -> ScoreInstrument -> ShowS)
-> (ScoreInstrument -> String)
-> ([ScoreInstrument] -> ShowS)
-> Show ScoreInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScoreInstrument] -> ShowS
$cshowList :: [ScoreInstrument] -> ShowS
show :: ScoreInstrument -> String
$cshow :: ScoreInstrument -> String
showsPrec :: Int -> ScoreInstrument -> ShowS
$cshowsPrec :: Int -> ScoreInstrument -> ShowS
Show)
instance EmitXml ScoreInstrument where
    emitXml :: ScoreInstrument -> XmlRep
emitXml (ScoreInstrument ID
a String
b Maybe String
c Maybe String
d Maybe ChxScoreInstrument
e Maybe VirtualInstrument
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ID
a)])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"instrument-name" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"instrument-abbreviation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"instrument-sound" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe ChxScoreInstrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe ChxScoreInstrument
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (VirtualInstrument -> XmlRep)
-> Maybe VirtualInstrument
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"virtual-instrument" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (VirtualInstrument -> XmlRep) -> VirtualInstrument -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.VirtualInstrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe VirtualInstrument
f])
parseScoreInstrument :: P.XParse ScoreInstrument
parseScoreInstrument :: XParse ScoreInstrument
parseScoreInstrument = 
      ID
-> String
-> Maybe String
-> Maybe String
-> Maybe ChxScoreInstrument
-> Maybe VirtualInstrument
-> ScoreInstrument
ScoreInstrument
        (ID
 -> String
 -> Maybe String
 -> Maybe String
 -> Maybe ChxScoreInstrument
 -> Maybe VirtualInstrument
 -> ScoreInstrument)
-> XParse ID
-> XParse
     (String
      -> Maybe String
      -> Maybe String
      -> Maybe ChxScoreInstrument
      -> Maybe VirtualInstrument
      -> ScoreInstrument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (String
   -> Maybe String
   -> Maybe String
   -> Maybe ChxScoreInstrument
   -> Maybe VirtualInstrument
   -> ScoreInstrument)
-> XParse String
-> XParse
     (Maybe String
      -> Maybe String
      -> Maybe ChxScoreInstrument
      -> Maybe VirtualInstrument
      -> ScoreInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"instrument-name") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe String
   -> Maybe String
   -> Maybe ChxScoreInstrument
   -> Maybe VirtualInstrument
   -> ScoreInstrument)
-> XParse (Maybe String)
-> XParse
     (Maybe String
      -> Maybe ChxScoreInstrument
      -> Maybe VirtualInstrument
      -> ScoreInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"instrument-abbreviation") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe String
   -> Maybe ChxScoreInstrument
   -> Maybe VirtualInstrument
   -> ScoreInstrument)
-> XParse (Maybe String)
-> XParse
     (Maybe ChxScoreInstrument
      -> Maybe VirtualInstrument -> ScoreInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"instrument-sound") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe ChxScoreInstrument
   -> Maybe VirtualInstrument -> ScoreInstrument)
-> XParse (Maybe ChxScoreInstrument)
-> XParse (Maybe VirtualInstrument -> ScoreInstrument)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxScoreInstrument -> XParse (Maybe ChxScoreInstrument)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse ChxScoreInstrument
parseChxScoreInstrument)
        XParse (Maybe VirtualInstrument -> ScoreInstrument)
-> XParse (Maybe VirtualInstrument) -> XParse ScoreInstrument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse VirtualInstrument -> XParse (Maybe VirtualInstrument)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse VirtualInstrument -> XParse VirtualInstrument
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"virtual-instrument") (XParse VirtualInstrument
parseVirtualInstrument))

-- | Smart constructor for 'ScoreInstrument'
mkScoreInstrument :: ID -> String -> ScoreInstrument
mkScoreInstrument :: ID -> String -> ScoreInstrument
mkScoreInstrument ID
a String
b = ID
-> String
-> Maybe String
-> Maybe String
-> Maybe ChxScoreInstrument
-> Maybe VirtualInstrument
-> ScoreInstrument
ScoreInstrument ID
a String
b Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe ChxScoreInstrument
forall a. Maybe a
Nothing Maybe VirtualInstrument
forall a. Maybe a
Nothing

-- | @score-part@ /(complex)/
--
-- Each MusicXML part corresponds to a track in a Standard MIDI Format 1 file. The score-instrument elements are used when there are multiple instruments per track. The midi-device element is used to make a MIDI device or port assignment for the given track or specific MIDI instruments. Initial midi-instrument assignments may be made here as well.
data CmpScorePart = 
      CmpScorePart {
          CmpScorePart -> ID
scorePartId :: ID -- ^ /id/ attribute
        , CmpScorePart -> Maybe Identification
scorePartIdentification :: (Maybe Identification) -- ^ /identification/ child element
        , CmpScorePart -> PartName
scorePartPartName :: PartName -- ^ /part-name/ child element
        , CmpScorePart -> Maybe NameDisplay
scorePartPartNameDisplay :: (Maybe NameDisplay) -- ^ /part-name-display/ child element
        , CmpScorePart -> Maybe PartName
scorePartPartAbbreviation :: (Maybe PartName) -- ^ /part-abbreviation/ child element
        , CmpScorePart -> Maybe NameDisplay
scorePartPartAbbreviationDisplay :: (Maybe NameDisplay) -- ^ /part-abbreviation-display/ child element
        , CmpScorePart -> [String]
scorePartGroup :: [String] -- ^ /group/ child element
        , CmpScorePart -> [ScoreInstrument]
scorePartScoreInstrument :: [ScoreInstrument] -- ^ /score-instrument/ child element
        , CmpScorePart -> [SeqScorePart]
scorePartScorePart :: [SeqScorePart]
       }
    deriving (CmpScorePart -> CmpScorePart -> Bool
(CmpScorePart -> CmpScorePart -> Bool)
-> (CmpScorePart -> CmpScorePart -> Bool) -> Eq CmpScorePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpScorePart -> CmpScorePart -> Bool
$c/= :: CmpScorePart -> CmpScorePart -> Bool
== :: CmpScorePart -> CmpScorePart -> Bool
$c== :: CmpScorePart -> CmpScorePart -> Bool
Eq,Typeable,(forall x. CmpScorePart -> Rep CmpScorePart x)
-> (forall x. Rep CmpScorePart x -> CmpScorePart)
-> Generic CmpScorePart
forall x. Rep CmpScorePart x -> CmpScorePart
forall x. CmpScorePart -> Rep CmpScorePart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpScorePart x -> CmpScorePart
$cfrom :: forall x. CmpScorePart -> Rep CmpScorePart x
Generic,Int -> CmpScorePart -> ShowS
[CmpScorePart] -> ShowS
CmpScorePart -> String
(Int -> CmpScorePart -> ShowS)
-> (CmpScorePart -> String)
-> ([CmpScorePart] -> ShowS)
-> Show CmpScorePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpScorePart] -> ShowS
$cshowList :: [CmpScorePart] -> ShowS
show :: CmpScorePart -> String
$cshow :: CmpScorePart -> String
showsPrec :: Int -> CmpScorePart -> ShowS
$cshowsPrec :: Int -> CmpScorePart -> ShowS
Show)
instance EmitXml CmpScorePart where
    emitXml :: CmpScorePart -> XmlRep
emitXml (CmpScorePart ID
a Maybe Identification
b PartName
c Maybe NameDisplay
d Maybe PartName
e Maybe NameDisplay
f [String]
g [ScoreInstrument]
h [SeqScorePart]
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing) (ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ID
a)])
        ([XmlRep
-> (Identification -> XmlRep) -> Maybe Identification -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"identification" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Identification -> XmlRep) -> Identification -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Identification -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Identification
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-name" Maybe String
forall a. Maybe a
Nothing) (PartName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PartName
c)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-name-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (PartName -> XmlRep) -> Maybe PartName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-abbreviation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (PartName -> XmlRep) -> PartName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PartName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PartName
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NameDisplay -> XmlRep) -> Maybe NameDisplay -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-abbreviation-display" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NameDisplay -> XmlRep) -> NameDisplay -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NameDisplay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NameDisplay
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (String -> XmlRep) -> [String] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"group" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [String]
g [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (ScoreInstrument -> XmlRep) -> [ScoreInstrument] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"score-instrument" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ScoreInstrument -> XmlRep) -> ScoreInstrument -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ScoreInstrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [ScoreInstrument]
h [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [[SeqScorePart] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [SeqScorePart]
i])
parseCmpScorePart :: P.XParse CmpScorePart
parseCmpScorePart :: XParse CmpScorePart
parseCmpScorePart = 
      ID
-> Maybe Identification
-> PartName
-> Maybe NameDisplay
-> Maybe PartName
-> Maybe NameDisplay
-> [String]
-> [ScoreInstrument]
-> [SeqScorePart]
-> CmpScorePart
CmpScorePart
        (ID
 -> Maybe Identification
 -> PartName
 -> Maybe NameDisplay
 -> Maybe PartName
 -> Maybe NameDisplay
 -> [String]
 -> [ScoreInstrument]
 -> [SeqScorePart]
 -> CmpScorePart)
-> XParse ID
-> XParse
     (Maybe Identification
      -> PartName
      -> Maybe NameDisplay
      -> Maybe PartName
      -> Maybe NameDisplay
      -> [String]
      -> [ScoreInstrument]
      -> [SeqScorePart]
      -> CmpScorePart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Maybe Identification
   -> PartName
   -> Maybe NameDisplay
   -> Maybe PartName
   -> Maybe NameDisplay
   -> [String]
   -> [ScoreInstrument]
   -> [SeqScorePart]
   -> CmpScorePart)
-> XParse (Maybe Identification)
-> XParse
     (PartName
      -> Maybe NameDisplay
      -> Maybe PartName
      -> Maybe NameDisplay
      -> [String]
      -> [ScoreInstrument]
      -> [SeqScorePart]
      -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Identification -> XParse (Maybe Identification)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Identification -> XParse Identification
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"identification") (XParse Identification
parseIdentification))
        XParse
  (PartName
   -> Maybe NameDisplay
   -> Maybe PartName
   -> Maybe NameDisplay
   -> [String]
   -> [ScoreInstrument]
   -> [SeqScorePart]
   -> CmpScorePart)
-> XParse PartName
-> XParse
     (Maybe NameDisplay
      -> Maybe PartName
      -> Maybe NameDisplay
      -> [String]
      -> [ScoreInstrument]
      -> [SeqScorePart]
      -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse PartName -> XParse PartName
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-name") (XParse PartName
parsePartName))
        XParse
  (Maybe NameDisplay
   -> Maybe PartName
   -> Maybe NameDisplay
   -> [String]
   -> [ScoreInstrument]
   -> [SeqScorePart]
   -> CmpScorePart)
-> XParse (Maybe NameDisplay)
-> XParse
     (Maybe PartName
      -> Maybe NameDisplay
      -> [String]
      -> [ScoreInstrument]
      -> [SeqScorePart]
      -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-name-display") (XParse NameDisplay
parseNameDisplay))
        XParse
  (Maybe PartName
   -> Maybe NameDisplay
   -> [String]
   -> [ScoreInstrument]
   -> [SeqScorePart]
   -> CmpScorePart)
-> XParse (Maybe PartName)
-> XParse
     (Maybe NameDisplay
      -> [String] -> [ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse PartName -> XParse (Maybe PartName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse PartName -> XParse PartName
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-abbreviation") (XParse PartName
parsePartName))
        XParse
  (Maybe NameDisplay
   -> [String] -> [ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
-> XParse (Maybe NameDisplay)
-> XParse
     ([String] -> [ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NameDisplay -> XParse (Maybe NameDisplay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NameDisplay -> XParse NameDisplay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-abbreviation-display") (XParse NameDisplay
parseNameDisplay))
        XParse
  ([String] -> [ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
-> XParse [String]
-> XParse ([ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"group") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse ([ScoreInstrument] -> [SeqScorePart] -> CmpScorePart)
-> XParse [ScoreInstrument]
-> XParse ([SeqScorePart] -> CmpScorePart)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ScoreInstrument -> XParse [ScoreInstrument]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse ScoreInstrument -> XParse ScoreInstrument
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"score-instrument") (XParse ScoreInstrument
parseScoreInstrument))
        XParse ([SeqScorePart] -> CmpScorePart)
-> XParse [SeqScorePart] -> XParse CmpScorePart
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqScorePart -> XParse [SeqScorePart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse SeqScorePart
parseSeqScorePart)

-- | Smart constructor for 'CmpScorePart'
mkCmpScorePart :: ID -> PartName -> CmpScorePart
mkCmpScorePart :: ID -> PartName -> CmpScorePart
mkCmpScorePart ID
a PartName
c = ID
-> Maybe Identification
-> PartName
-> Maybe NameDisplay
-> Maybe PartName
-> Maybe NameDisplay
-> [String]
-> [ScoreInstrument]
-> [SeqScorePart]
-> CmpScorePart
CmpScorePart ID
a Maybe Identification
forall a. Maybe a
Nothing PartName
c Maybe NameDisplay
forall a. Maybe a
Nothing Maybe PartName
forall a. Maybe a
Nothing Maybe NameDisplay
forall a. Maybe a
Nothing [] [] []

-- | @score-partwise@ /(complex)/
data ScorePartwise = 
      ScorePartwise {
          ScorePartwise -> Maybe Token
scorePartwiseVersion :: (Maybe Token) -- ^ /version/ attribute
        , ScorePartwise -> ScoreHeader
scorePartwiseScoreHeader :: ScoreHeader
        , ScorePartwise -> [CmpPart]
scorePartwisePart :: [CmpPart] -- ^ /part/ child element
       }
    deriving (ScorePartwise -> ScorePartwise -> Bool
(ScorePartwise -> ScorePartwise -> Bool)
-> (ScorePartwise -> ScorePartwise -> Bool) -> Eq ScorePartwise
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScorePartwise -> ScorePartwise -> Bool
$c/= :: ScorePartwise -> ScorePartwise -> Bool
== :: ScorePartwise -> ScorePartwise -> Bool
$c== :: ScorePartwise -> ScorePartwise -> Bool
Eq,Typeable,(forall x. ScorePartwise -> Rep ScorePartwise x)
-> (forall x. Rep ScorePartwise x -> ScorePartwise)
-> Generic ScorePartwise
forall x. Rep ScorePartwise x -> ScorePartwise
forall x. ScorePartwise -> Rep ScorePartwise x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScorePartwise x -> ScorePartwise
$cfrom :: forall x. ScorePartwise -> Rep ScorePartwise x
Generic,Int -> ScorePartwise -> ShowS
[ScorePartwise] -> ShowS
ScorePartwise -> String
(Int -> ScorePartwise -> ShowS)
-> (ScorePartwise -> String)
-> ([ScorePartwise] -> ShowS)
-> Show ScorePartwise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScorePartwise] -> ShowS
$cshowList :: [ScorePartwise] -> ShowS
show :: ScorePartwise -> String
$cshow :: ScorePartwise -> String
showsPrec :: Int -> ScorePartwise -> ShowS
$cshowsPrec :: Int -> ScorePartwise -> ShowS
Show)
instance EmitXml ScorePartwise where
    emitXml :: ScorePartwise -> XmlRep
emitXml (ScorePartwise Maybe Token
a ScoreHeader
b [CmpPart]
c) =
      QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"score-partwise" Maybe String
forall a. Maybe a
Nothing) (XmlRep -> XmlRep) -> XmlRep -> XmlRep
forall a b. (a -> b) -> a -> b
$ XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"version" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
a])
        ([ScoreHeader -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ScoreHeader
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (CmpPart -> XmlRep) -> [CmpPart] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (CmpPart -> XmlRep) -> CmpPart -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CmpPart -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [CmpPart]
c)
parseScorePartwise :: P.XParse ScorePartwise
parseScorePartwise :: XParse ScorePartwise
parseScorePartwise = 
      Maybe Token -> ScoreHeader -> [CmpPart] -> ScorePartwise
ScorePartwise
        (Maybe Token -> ScoreHeader -> [CmpPart] -> ScorePartwise)
-> XParse (Maybe Token)
-> XParse (ScoreHeader -> [CmpPart] -> ScorePartwise)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"version") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (ScoreHeader -> [CmpPart] -> ScorePartwise)
-> XParse ScoreHeader -> XParse ([CmpPart] -> ScorePartwise)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ScoreHeader
parseScoreHeader
        XParse ([CmpPart] -> ScorePartwise)
-> XParse [CmpPart] -> XParse ScorePartwise
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CmpPart -> XParse [CmpPart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse CmpPart -> XParse CmpPart
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part") (XParse CmpPart
parseCmpPart))

-- | Smart constructor for 'ScorePartwise'
mkScorePartwise :: ScoreHeader -> ScorePartwise
mkScorePartwise :: ScoreHeader -> ScorePartwise
mkScorePartwise ScoreHeader
b = Maybe Token -> ScoreHeader -> [CmpPart] -> ScorePartwise
ScorePartwise Maybe Token
forall a. Maybe a
Nothing ScoreHeader
b []

-- | @score-timewise@ /(complex)/
data ScoreTimewise = 
      ScoreTimewise {
          ScoreTimewise -> Maybe Token
scoreTimewiseVersion :: (Maybe Token) -- ^ /version/ attribute
        , ScoreTimewise -> ScoreHeader
scoreTimewiseScoreHeader :: ScoreHeader
        , ScoreTimewise -> [CmpMeasure]
scoreTimewiseMeasure :: [CmpMeasure] -- ^ /measure/ child element
       }
    deriving (ScoreTimewise -> ScoreTimewise -> Bool
(ScoreTimewise -> ScoreTimewise -> Bool)
-> (ScoreTimewise -> ScoreTimewise -> Bool) -> Eq ScoreTimewise
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreTimewise -> ScoreTimewise -> Bool
$c/= :: ScoreTimewise -> ScoreTimewise -> Bool
== :: ScoreTimewise -> ScoreTimewise -> Bool
$c== :: ScoreTimewise -> ScoreTimewise -> Bool
Eq,Typeable,(forall x. ScoreTimewise -> Rep ScoreTimewise x)
-> (forall x. Rep ScoreTimewise x -> ScoreTimewise)
-> Generic ScoreTimewise
forall x. Rep ScoreTimewise x -> ScoreTimewise
forall x. ScoreTimewise -> Rep ScoreTimewise x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScoreTimewise x -> ScoreTimewise
$cfrom :: forall x. ScoreTimewise -> Rep ScoreTimewise x
Generic,Int -> ScoreTimewise -> ShowS
[ScoreTimewise] -> ShowS
ScoreTimewise -> String
(Int -> ScoreTimewise -> ShowS)
-> (ScoreTimewise -> String)
-> ([ScoreTimewise] -> ShowS)
-> Show ScoreTimewise
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScoreTimewise] -> ShowS
$cshowList :: [ScoreTimewise] -> ShowS
show :: ScoreTimewise -> String
$cshow :: ScoreTimewise -> String
showsPrec :: Int -> ScoreTimewise -> ShowS
$cshowsPrec :: Int -> ScoreTimewise -> ShowS
Show)
instance EmitXml ScoreTimewise where
    emitXml :: ScoreTimewise -> XmlRep
emitXml (ScoreTimewise Maybe Token
a ScoreHeader
b [CmpMeasure]
c) =
      QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"score-timewise" Maybe String
forall a. Maybe a
Nothing) (XmlRep -> XmlRep) -> XmlRep -> XmlRep
forall a b. (a -> b) -> a -> b
$ XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"version" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
a])
        ([ScoreHeader -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ScoreHeader
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (CmpMeasure -> XmlRep) -> [CmpMeasure] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CmpMeasure -> XmlRep) -> CmpMeasure -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CmpMeasure -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [CmpMeasure]
c)
parseScoreTimewise :: P.XParse ScoreTimewise
parseScoreTimewise :: XParse ScoreTimewise
parseScoreTimewise = 
      Maybe Token -> ScoreHeader -> [CmpMeasure] -> ScoreTimewise
ScoreTimewise
        (Maybe Token -> ScoreHeader -> [CmpMeasure] -> ScoreTimewise)
-> XParse (Maybe Token)
-> XParse (ScoreHeader -> [CmpMeasure] -> ScoreTimewise)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"version") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse (ScoreHeader -> [CmpMeasure] -> ScoreTimewise)
-> XParse ScoreHeader -> XParse ([CmpMeasure] -> ScoreTimewise)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ScoreHeader
parseScoreHeader
        XParse ([CmpMeasure] -> ScoreTimewise)
-> XParse [CmpMeasure] -> XParse ScoreTimewise
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CmpMeasure -> XParse [CmpMeasure]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse CmpMeasure -> XParse CmpMeasure
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure") (XParse CmpMeasure
parseCmpMeasure))

-- | Smart constructor for 'ScoreTimewise'
mkScoreTimewise :: ScoreHeader -> ScoreTimewise
mkScoreTimewise :: ScoreHeader -> ScoreTimewise
mkScoreTimewise ScoreHeader
b = Maybe Token -> ScoreHeader -> [CmpMeasure] -> ScoreTimewise
ScoreTimewise Maybe Token
forall a. Maybe a
Nothing ScoreHeader
b []

-- | @segno@ /(complex)/
--
-- The segno type is the visual indicator of a segno sign. The exact glyph can be specified with the smufl attribute. A sound element is also needed to guide playback applications reliably.
data Segno = 
      Segno {
          Segno -> Maybe SmuflSegnoGlyphName
segnoSmufl :: (Maybe SmuflSegnoGlyphName) -- ^ /smufl/ attribute
        , Segno -> Maybe Tenths
segnoDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Segno -> Maybe Tenths
segnoDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Segno -> Maybe Tenths
segnoRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Segno -> Maybe Tenths
segnoRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Segno -> Maybe CommaSeparatedText
segnoFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Segno -> Maybe FontStyle
segnoFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Segno -> Maybe FontSize
segnoFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Segno -> Maybe FontWeight
segnoFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Segno -> Maybe Color
segnoColor :: (Maybe Color) -- ^ /color/ attribute
        , Segno -> Maybe LeftCenterRight
segnoHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Segno -> Maybe Valign
segnoValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Segno -> Maybe ID
segnoId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Segno -> Segno -> Bool
(Segno -> Segno -> Bool) -> (Segno -> Segno -> Bool) -> Eq Segno
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segno -> Segno -> Bool
$c/= :: Segno -> Segno -> Bool
== :: Segno -> Segno -> Bool
$c== :: Segno -> Segno -> Bool
Eq,Typeable,(forall x. Segno -> Rep Segno x)
-> (forall x. Rep Segno x -> Segno) -> Generic Segno
forall x. Rep Segno x -> Segno
forall x. Segno -> Rep Segno x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Segno x -> Segno
$cfrom :: forall x. Segno -> Rep Segno x
Generic,Int -> Segno -> ShowS
[Segno] -> ShowS
Segno -> String
(Int -> Segno -> ShowS)
-> (Segno -> String) -> ([Segno] -> ShowS) -> Show Segno
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segno] -> ShowS
$cshowList :: [Segno] -> ShowS
show :: Segno -> String
$cshow :: Segno -> String
showsPrec :: Int -> Segno -> ShowS
$cshowsPrec :: Int -> Segno -> ShowS
Show)
instance EmitXml Segno where
    emitXml :: Segno -> XmlRep
emitXml (Segno Maybe SmuflSegnoGlyphName
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (SmuflSegnoGlyphName -> XmlRep)
-> Maybe SmuflSegnoGlyphName
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflSegnoGlyphName -> XmlRep) -> SmuflSegnoGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflSegnoGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflSegnoGlyphName
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseSegno :: P.XParse Segno
parseSegno :: XParse Segno
parseSegno = 
      Maybe SmuflSegnoGlyphName
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Segno
Segno
        (Maybe SmuflSegnoGlyphName
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> Segno)
-> XParse (Maybe SmuflSegnoGlyphName)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SmuflSegnoGlyphName -> XParse (Maybe SmuflSegnoGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflSegnoGlyphName)
-> XParse SmuflSegnoGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflSegnoGlyphName
parseSmuflSegnoGlyphName)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> Segno)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Segno)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> Segno)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> Segno)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> Segno)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> Segno) -> XParse (Maybe ID) -> XParse Segno
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Segno'
mkSegno :: Segno
mkSegno :: Segno
mkSegno = Maybe SmuflSegnoGlyphName
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> Segno
Segno Maybe SmuflSegnoGlyphName
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @slash@ /(complex)/
--
-- The slash type is used to indicate that slash notation is to be used. If the slash is on every beat, use-stems is no (the default). To indicate rhythms but not pitches, use-stems is set to yes. The type attribute indicates whether this is the start or stop of a slash notation style. The use-dots attribute works as for the beat-repeat element, and only has effect if use-stems is no.
data CmpSlash = 
      CmpSlash {
          CmpSlash -> StartStop
slashType :: StartStop -- ^ /type/ attribute
        , CmpSlash -> Maybe YesNo
slashUseDots :: (Maybe YesNo) -- ^ /use-dots/ attribute
        , CmpSlash -> Maybe YesNo
slashUseStems :: (Maybe YesNo) -- ^ /use-stems/ attribute
        , CmpSlash -> Maybe Slash
slashSlash :: (Maybe Slash)
       }
    deriving (CmpSlash -> CmpSlash -> Bool
(CmpSlash -> CmpSlash -> Bool)
-> (CmpSlash -> CmpSlash -> Bool) -> Eq CmpSlash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpSlash -> CmpSlash -> Bool
$c/= :: CmpSlash -> CmpSlash -> Bool
== :: CmpSlash -> CmpSlash -> Bool
$c== :: CmpSlash -> CmpSlash -> Bool
Eq,Typeable,(forall x. CmpSlash -> Rep CmpSlash x)
-> (forall x. Rep CmpSlash x -> CmpSlash) -> Generic CmpSlash
forall x. Rep CmpSlash x -> CmpSlash
forall x. CmpSlash -> Rep CmpSlash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpSlash x -> CmpSlash
$cfrom :: forall x. CmpSlash -> Rep CmpSlash x
Generic,Int -> CmpSlash -> ShowS
[CmpSlash] -> ShowS
CmpSlash -> String
(Int -> CmpSlash -> ShowS)
-> (CmpSlash -> String) -> ([CmpSlash] -> ShowS) -> Show CmpSlash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpSlash] -> ShowS
$cshowList :: [CmpSlash] -> ShowS
show :: CmpSlash -> String
$cshow :: CmpSlash -> String
showsPrec :: Int -> CmpSlash -> ShowS
$cshowsPrec :: Int -> CmpSlash -> ShowS
Show)
instance EmitXml CmpSlash where
    emitXml :: CmpSlash -> XmlRep
emitXml (CmpSlash StartStop
a Maybe YesNo
b Maybe YesNo
c Maybe Slash
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"use-dots" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"use-stems" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c])
        ([Maybe Slash -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Slash
d])
parseCmpSlash :: P.XParse CmpSlash
parseCmpSlash :: XParse CmpSlash
parseCmpSlash = 
      StartStop -> Maybe YesNo -> Maybe YesNo -> Maybe Slash -> CmpSlash
CmpSlash
        (StartStop
 -> Maybe YesNo -> Maybe YesNo -> Maybe Slash -> CmpSlash)
-> XParse StartStop
-> XParse (Maybe YesNo -> Maybe YesNo -> Maybe Slash -> CmpSlash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse (Maybe YesNo -> Maybe YesNo -> Maybe Slash -> CmpSlash)
-> XParse (Maybe YesNo)
-> XParse (Maybe YesNo -> Maybe Slash -> CmpSlash)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"use-dots") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe YesNo -> Maybe Slash -> CmpSlash)
-> XParse (Maybe YesNo) -> XParse (Maybe Slash -> CmpSlash)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"use-stems") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe Slash -> CmpSlash)
-> XParse (Maybe Slash) -> XParse CmpSlash
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Slash -> XParse (Maybe Slash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Slash
parseSlash)

-- | Smart constructor for 'CmpSlash'
mkCmpSlash :: StartStop -> CmpSlash
mkCmpSlash :: StartStop -> CmpSlash
mkCmpSlash StartStop
a = StartStop -> Maybe YesNo -> Maybe YesNo -> Maybe Slash -> CmpSlash
CmpSlash StartStop
a Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Slash
forall a. Maybe a
Nothing

-- | @slide@ /(complex)/
--
-- Glissando and slide types both indicate rapidly moving from one pitch to the other so that individual notes are not discerned. The distinction is similar to that between NIFF's glissando and portamento elements. A slide is continuous between two notes and defaults to a solid line. The optional text for a is printed alongside the line.
data Slide = 
      Slide {
          Slide -> String
slideString :: String -- ^ text content
        , Slide -> StartStop
slideType :: StartStop -- ^ /type/ attribute
        , Slide -> Maybe NumberLevel
slideNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Slide -> Maybe LineType
slideLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Slide -> Maybe Tenths
slideDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Slide -> Maybe Tenths
slideSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Slide -> Maybe Tenths
slideDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Slide -> Maybe Tenths
slideDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Slide -> Maybe Tenths
slideRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Slide -> Maybe Tenths
slideRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Slide -> Maybe CommaSeparatedText
slideFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Slide -> Maybe FontStyle
slideFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Slide -> Maybe FontSize
slideFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Slide -> Maybe FontWeight
slideFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Slide -> Maybe Color
slideColor :: (Maybe Color) -- ^ /color/ attribute
        , Slide -> Maybe YesNo
slideAccelerate :: (Maybe YesNo) -- ^ /accelerate/ attribute
        , Slide -> Maybe TrillBeats
slideBeats :: (Maybe TrillBeats) -- ^ /beats/ attribute
        , Slide -> Maybe Percent
slideFirstBeat :: (Maybe Percent) -- ^ /first-beat/ attribute
        , Slide -> Maybe Percent
slideLastBeat :: (Maybe Percent) -- ^ /last-beat/ attribute
        , Slide -> Maybe ID
slideId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Slide -> Slide -> Bool
(Slide -> Slide -> Bool) -> (Slide -> Slide -> Bool) -> Eq Slide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slide -> Slide -> Bool
$c/= :: Slide -> Slide -> Bool
== :: Slide -> Slide -> Bool
$c== :: Slide -> Slide -> Bool
Eq,Typeable,(forall x. Slide -> Rep Slide x)
-> (forall x. Rep Slide x -> Slide) -> Generic Slide
forall x. Rep Slide x -> Slide
forall x. Slide -> Rep Slide x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Slide x -> Slide
$cfrom :: forall x. Slide -> Rep Slide x
Generic,Int -> Slide -> ShowS
[Slide] -> ShowS
Slide -> String
(Int -> Slide -> ShowS)
-> (Slide -> String) -> ([Slide] -> ShowS) -> Show Slide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slide] -> ShowS
$cshowList :: [Slide] -> ShowS
show :: Slide -> String
$cshow :: Slide -> String
showsPrec :: Int -> Slide -> ShowS
$cshowsPrec :: Int -> Slide -> ShowS
Show)
instance EmitXml Slide where
    emitXml :: Slide -> XmlRep
emitXml (Slide String
a StartStop
b Maybe NumberLevel
c Maybe LineType
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe CommaSeparatedText
k Maybe FontStyle
l Maybe FontSize
m Maybe FontWeight
n Maybe Color
o Maybe YesNo
p Maybe TrillBeats
q Maybe Percent
r Maybe Percent
s Maybe ID
t) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"accelerate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillBeats -> XmlRep) -> Maybe TrillBeats -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TrillBeats -> XmlRep) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillBeats -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillBeats
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"first-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"last-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
t])
        []
parseSlide :: P.XParse Slide
parseSlide :: XParse Slide
parseSlide = 
      String
-> StartStop
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> Maybe ID
-> Slide
Slide
        (String
 -> StartStop
 -> Maybe NumberLevel
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe YesNo
 -> Maybe TrillBeats
 -> Maybe Percent
 -> Maybe Percent
 -> Maybe ID
 -> Slide)
-> XParse String
-> XParse
     (StartStop
      -> Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (StartStop
   -> Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse StartStop
-> XParse
     (Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe Color)
-> XParse
     (Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> Maybe ID
      -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> Maybe ID
   -> Slide)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe TrillBeats
      -> Maybe Percent -> Maybe Percent -> Maybe ID -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"accelerate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe TrillBeats
   -> Maybe Percent -> Maybe Percent -> Maybe ID -> Slide)
-> XParse (Maybe TrillBeats)
-> XParse (Maybe Percent -> Maybe Percent -> Maybe ID -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillBeats -> XParse (Maybe TrillBeats)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"beats") XParse String -> (String -> XParse TrillBeats) -> XParse TrillBeats
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillBeats
parseTrillBeats)
        XParse (Maybe Percent -> Maybe Percent -> Maybe ID -> Slide)
-> XParse (Maybe Percent)
-> XParse (Maybe Percent -> Maybe ID -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"first-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Percent -> Maybe ID -> Slide)
-> XParse (Maybe Percent) -> XParse (Maybe ID -> Slide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"last-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe ID -> Slide) -> XParse (Maybe ID) -> XParse Slide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Slide'
mkSlide :: String -> StartStop -> Slide
mkSlide :: String -> StartStop -> Slide
mkSlide String
a StartStop
b = String
-> StartStop
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> Maybe ID
-> Slide
Slide String
a StartStop
b Maybe NumberLevel
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe TrillBeats
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @slur@ /(complex)/
--
-- Slur types are empty. Most slurs are represented with two elements: one with a start type, and one with a stop type. Slurs can add more elements using a continue type. This is typically used to specify the formatting of cross-system slurs, or to specify the shape of very complex slurs.
data Slur = 
      Slur {
          Slur -> StartStopContinue
slurType :: StartStopContinue -- ^ /type/ attribute
        , Slur -> Maybe NumberLevel
slurNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Slur -> Maybe LineType
slurLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Slur -> Maybe Tenths
slurDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Slur -> Maybe Tenths
slurSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Slur -> Maybe Tenths
slurDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Slur -> Maybe Tenths
slurDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Slur -> Maybe Tenths
slurRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Slur -> Maybe Tenths
slurRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Slur -> Maybe AboveBelow
slurPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Slur -> Maybe OverUnder
slurOrientation :: (Maybe OverUnder) -- ^ /orientation/ attribute
        , Slur -> Maybe Tenths
slurBezierX :: (Maybe Tenths) -- ^ /bezier-x/ attribute
        , Slur -> Maybe Tenths
slurBezierY :: (Maybe Tenths) -- ^ /bezier-y/ attribute
        , Slur -> Maybe Tenths
slurBezierX2 :: (Maybe Tenths) -- ^ /bezier-x2/ attribute
        , Slur -> Maybe Tenths
slurBezierY2 :: (Maybe Tenths) -- ^ /bezier-y2/ attribute
        , Slur -> Maybe Divisions
slurBezierOffset :: (Maybe Divisions) -- ^ /bezier-offset/ attribute
        , Slur -> Maybe Divisions
slurBezierOffset2 :: (Maybe Divisions) -- ^ /bezier-offset2/ attribute
        , Slur -> Maybe Color
slurColor :: (Maybe Color) -- ^ /color/ attribute
        , Slur -> Maybe ID
slurId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Slur -> Slur -> Bool
(Slur -> Slur -> Bool) -> (Slur -> Slur -> Bool) -> Eq Slur
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slur -> Slur -> Bool
$c/= :: Slur -> Slur -> Bool
== :: Slur -> Slur -> Bool
$c== :: Slur -> Slur -> Bool
Eq,Typeable,(forall x. Slur -> Rep Slur x)
-> (forall x. Rep Slur x -> Slur) -> Generic Slur
forall x. Rep Slur x -> Slur
forall x. Slur -> Rep Slur x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Slur x -> Slur
$cfrom :: forall x. Slur -> Rep Slur x
Generic,Int -> Slur -> ShowS
[Slur] -> ShowS
Slur -> String
(Int -> Slur -> ShowS)
-> (Slur -> String) -> ([Slur] -> ShowS) -> Show Slur
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slur] -> ShowS
$cshowList :: [Slur] -> ShowS
show :: Slur -> String
$cshow :: Slur -> String
showsPrec :: Int -> Slur -> ShowS
$cshowsPrec :: Int -> Slur -> ShowS
Show)
instance EmitXml Slur where
    emitXml :: Slur -> XmlRep
emitXml (Slur StartStopContinue
a Maybe NumberLevel
b Maybe LineType
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe AboveBelow
j Maybe OverUnder
k Maybe Tenths
l Maybe Tenths
m Maybe Tenths
n Maybe Tenths
o Maybe Divisions
p Maybe Divisions
q Maybe Color
r Maybe ID
s) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopContinue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (OverUnder -> XmlRep) -> Maybe OverUnder -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"orientation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (OverUnder -> XmlRep) -> OverUnder -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.OverUnder -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe OverUnder
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-x2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-y2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-offset" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-offset2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
s])
        []
parseSlur :: P.XParse Slur
parseSlur :: XParse Slur
parseSlur = 
      StartStopContinue
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe OverUnder
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Divisions
-> Maybe Divisions
-> Maybe Color
-> Maybe ID
-> Slur
Slur
        (StartStopContinue
 -> Maybe NumberLevel
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe OverUnder
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Divisions
 -> Maybe Divisions
 -> Maybe Color
 -> Maybe ID
 -> Slur)
-> XParse StartStopContinue
-> XParse
     (Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopContinue) -> XParse StartStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopContinue
parseStartStopContinue)
        XParse
  (Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe OverUnder)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse OverUnder -> XParse (Maybe OverUnder)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"orientation") XParse String -> (String -> XParse OverUnder) -> XParse OverUnder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse OverUnder
parseOverUnder)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-x2") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Slur)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Divisions
      -> Maybe Divisions -> Maybe Color -> Maybe ID -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-y2") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Divisions
   -> Maybe Divisions -> Maybe Color -> Maybe ID -> Slur)
-> XParse (Maybe Divisions)
-> XParse (Maybe Divisions -> Maybe Color -> Maybe ID -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-offset") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe Divisions -> Maybe Color -> Maybe ID -> Slur)
-> XParse (Maybe Divisions)
-> XParse (Maybe Color -> Maybe ID -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-offset2") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe Color -> Maybe ID -> Slur)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Slur)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Slur) -> XParse (Maybe ID) -> XParse Slur
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Slur'
mkSlur :: StartStopContinue -> Slur
mkSlur :: StartStopContinue -> Slur
mkSlur StartStopContinue
a = StartStopContinue
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe OverUnder
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Divisions
-> Maybe Divisions
-> Maybe Color
-> Maybe ID
-> Slur
Slur StartStopContinue
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe OverUnder
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @sound@ /(complex)/
--
-- The sound element contains general playback parameters. They can stand alone within a part/measure, or be a component element within a direction.
--
-- @
-- 
-- Tempo is expressed in quarter notes per minute. If 0, the sound-generating program should prompt the user at the time of compiling a sound (MIDI) file.
-- 
-- Dynamics (or MIDI velocity) are expressed as a percentage of the default forte value (90 for MIDI 1.0).
-- 
-- Dacapo indicates to go back to the beginning of the movement. When used it always has the value "yes".
-- 
-- Segno and dalsegno are used for backwards jumps to a segno sign; coda and tocoda are used for forward jumps to a coda sign. If there are multiple jumps, the value of these parameters can be used to name and distinguish them. If segno or coda is used, the divisions attribute can also be used to indicate the number of divisions per quarter note. Otherwise sound and MIDI generating programs may have to recompute this.
-- 
-- By default, a dalsegno or dacapo attribute indicates that the jump should occur the first time through, while a tocoda attribute indicates the jump should occur the second time through. The time that jumps occur can be changed by using the time-only attribute.
-- 
-- Forward-repeat is used when a forward repeat sign is implied, and usually follows a bar line. When used it always has the value of "yes".
-- 
-- The fine attribute follows the final note or rest in a movement with a da capo or dal segno direction. If numeric, the value represents the actual duration of the final note or rest, which can be ambiguous in written notation and different among parts and voices. The value may also be "yes" to indicate no change to the final duration.
-- 
-- If the sound element applies only particular times through a repeat, the time-only attribute indicates which times to apply the sound element.
-- 
-- Pizzicato in a sound element effects all following notes. Yes indicates pizzicato, no indicates arco.
-- 
-- The pan and elevation attributes are deprecated in Version 2.0. The pan and elevation elements in the midi-instrument element should be used instead. The meaning of the pan and elevation attributes is the same as for the pan and elevation elements. If both are present, the mid-instrument elements take priority.
-- 
-- The damper-pedal, soft-pedal, and sostenuto-pedal attributes effect playback of the three common piano pedals and their MIDI controller equivalents. The yes value indicates the pedal is depressed; no indicates the pedal is released. A numeric value from 0 to 100 may also be used for half pedaling. This value is the percentage that the pedal is depressed. A value of 0 is equivalent to no, and a value of 100 is equivalent to yes.
-- 
-- MIDI devices, MIDI instruments, and playback techniques are changed using the midi-device, midi-instrument, and play elements. When there are multiple instances of these elements, they should be grouped together by instrument using the id attribute values.
-- 
-- The offset element is used to indicate that the sound takes place offset from the current score position. If the sound element is a child of a direction element, the sound offset element overrides the direction offset element if both elements are present. Note that the offset reflects the intended musical position for the change in sound. It should not be used to compensate for latency issues in particular hardware configurations.
-- @
data Sound = 
      Sound {
          Sound -> Maybe NonNegativeDecimal
soundTempo :: (Maybe NonNegativeDecimal) -- ^ /tempo/ attribute
        , Sound -> Maybe NonNegativeDecimal
soundDynamics :: (Maybe NonNegativeDecimal) -- ^ /dynamics/ attribute
        , Sound -> Maybe YesNo
soundDacapo :: (Maybe YesNo) -- ^ /dacapo/ attribute
        , Sound -> Maybe Token
soundSegno :: (Maybe Token) -- ^ /segno/ attribute
        , Sound -> Maybe Token
soundDalsegno :: (Maybe Token) -- ^ /dalsegno/ attribute
        , Sound -> Maybe Token
soundCoda :: (Maybe Token) -- ^ /coda/ attribute
        , Sound -> Maybe Token
soundTocoda :: (Maybe Token) -- ^ /tocoda/ attribute
        , Sound -> Maybe Divisions
soundDivisions :: (Maybe Divisions) -- ^ /divisions/ attribute
        , Sound -> Maybe YesNo
soundForwardRepeat :: (Maybe YesNo) -- ^ /forward-repeat/ attribute
        , Sound -> Maybe Token
soundFine :: (Maybe Token) -- ^ /fine/ attribute
        , Sound -> Maybe TimeOnly
soundTimeOnly :: (Maybe TimeOnly) -- ^ /time-only/ attribute
        , Sound -> Maybe YesNo
soundPizzicato :: (Maybe YesNo) -- ^ /pizzicato/ attribute
        , Sound -> Maybe RotationDegrees
soundPan :: (Maybe RotationDegrees) -- ^ /pan/ attribute
        , Sound -> Maybe RotationDegrees
soundElevation :: (Maybe RotationDegrees) -- ^ /elevation/ attribute
        , Sound -> Maybe YesNoNumber
soundDamperPedal :: (Maybe YesNoNumber) -- ^ /damper-pedal/ attribute
        , Sound -> Maybe YesNoNumber
soundSoftPedal :: (Maybe YesNoNumber) -- ^ /soft-pedal/ attribute
        , Sound -> Maybe YesNoNumber
soundSostenutoPedal :: (Maybe YesNoNumber) -- ^ /sostenuto-pedal/ attribute
        , Sound -> Maybe ID
soundId :: (Maybe ID) -- ^ /id/ attribute
        , Sound -> [SeqSound]
soundSound :: [SeqSound]
        , Sound -> Maybe Offset
soundOffset :: (Maybe Offset) -- ^ /offset/ child element
       }
    deriving (Sound -> Sound -> Bool
(Sound -> Sound -> Bool) -> (Sound -> Sound -> Bool) -> Eq Sound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sound -> Sound -> Bool
$c/= :: Sound -> Sound -> Bool
== :: Sound -> Sound -> Bool
$c== :: Sound -> Sound -> Bool
Eq,Typeable,(forall x. Sound -> Rep Sound x)
-> (forall x. Rep Sound x -> Sound) -> Generic Sound
forall x. Rep Sound x -> Sound
forall x. Sound -> Rep Sound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Sound x -> Sound
$cfrom :: forall x. Sound -> Rep Sound x
Generic,Int -> Sound -> ShowS
[Sound] -> ShowS
Sound -> String
(Int -> Sound -> ShowS)
-> (Sound -> String) -> ([Sound] -> ShowS) -> Show Sound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sound] -> ShowS
$cshowList :: [Sound] -> ShowS
show :: Sound -> String
$cshow :: Sound -> String
showsPrec :: Int -> Sound -> ShowS
$cshowsPrec :: Int -> Sound -> ShowS
Show)
instance EmitXml Sound where
    emitXml :: Sound -> XmlRep
emitXml (Sound Maybe NonNegativeDecimal
a Maybe NonNegativeDecimal
b Maybe YesNo
c Maybe Token
d Maybe Token
e Maybe Token
f Maybe Token
g Maybe Divisions
h Maybe YesNo
i Maybe Token
j Maybe TimeOnly
k Maybe YesNo
l Maybe RotationDegrees
m Maybe RotationDegrees
n Maybe YesNoNumber
o Maybe YesNoNumber
p Maybe YesNoNumber
q Maybe ID
r [SeqSound]
s Maybe Offset
t) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (NonNegativeDecimal -> XmlRep)
-> Maybe NonNegativeDecimal
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"tempo" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeDecimal -> XmlRep) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeDecimal
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeDecimal -> XmlRep)
-> Maybe NonNegativeDecimal
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dynamics" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeDecimal -> XmlRep) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeDecimal
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dacapo" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"segno" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dalsegno" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"coda" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"tocoda" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"divisions" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"forward-repeat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"fine" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TimeOnly -> XmlRep) -> Maybe TimeOnly -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"time-only" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TimeOnly -> XmlRep) -> TimeOnly -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeOnly -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeOnly
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"pizzicato" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"pan" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"elevation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNoNumber -> XmlRep) -> Maybe YesNoNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"damper-pedal" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (YesNoNumber -> XmlRep) -> YesNoNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNoNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNoNumber
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNoNumber -> XmlRep) -> Maybe YesNoNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"soft-pedal" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (YesNoNumber -> XmlRep) -> YesNoNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNoNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNoNumber
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNoNumber -> XmlRep) -> Maybe YesNoNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"sostenuto-pedal" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (YesNoNumber -> XmlRep) -> YesNoNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNoNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNoNumber
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
r])
        ([[SeqSound] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [SeqSound]
s] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Offset -> XmlRep) -> Maybe Offset -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"offset" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Offset -> XmlRep) -> Offset -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Offset -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Offset
t])
parseSound :: P.XParse Sound
parseSound :: XParse Sound
parseSound = 
      Maybe NonNegativeDecimal
-> Maybe NonNegativeDecimal
-> Maybe YesNo
-> Maybe Token
-> Maybe Token
-> Maybe Token
-> Maybe Token
-> Maybe Divisions
-> Maybe YesNo
-> Maybe Token
-> Maybe TimeOnly
-> Maybe YesNo
-> Maybe RotationDegrees
-> Maybe RotationDegrees
-> Maybe YesNoNumber
-> Maybe YesNoNumber
-> Maybe YesNoNumber
-> Maybe ID
-> [SeqSound]
-> Maybe Offset
-> Sound
Sound
        (Maybe NonNegativeDecimal
 -> Maybe NonNegativeDecimal
 -> Maybe YesNo
 -> Maybe Token
 -> Maybe Token
 -> Maybe Token
 -> Maybe Token
 -> Maybe Divisions
 -> Maybe YesNo
 -> Maybe Token
 -> Maybe TimeOnly
 -> Maybe YesNo
 -> Maybe RotationDegrees
 -> Maybe RotationDegrees
 -> Maybe YesNoNumber
 -> Maybe YesNoNumber
 -> Maybe YesNoNumber
 -> Maybe ID
 -> [SeqSound]
 -> Maybe Offset
 -> Sound)
-> XParse (Maybe NonNegativeDecimal)
-> XParse
     (Maybe NonNegativeDecimal
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NonNegativeDecimal -> XParse (Maybe NonNegativeDecimal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"tempo") XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal)
        XParse
  (Maybe NonNegativeDecimal
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe NonNegativeDecimal)
-> XParse
     (Maybe YesNo
      -> Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeDecimal -> XParse (Maybe NonNegativeDecimal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dynamics") XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal)
        XParse
  (Maybe YesNo
   -> Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dacapo") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Token)
-> XParse
     (Maybe Token
      -> Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"segno") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Token
   -> Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Token)
-> XParse
     (Maybe Token
      -> Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dalsegno") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Token
   -> Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Token)
-> XParse
     (Maybe Token
      -> Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"coda") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Token
   -> Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Token)
-> XParse
     (Maybe Divisions
      -> Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"tocoda") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe Divisions
   -> Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Divisions)
-> XParse
     (Maybe YesNo
      -> Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"divisions") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse
  (Maybe YesNo
   -> Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe Token
      -> Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"forward-repeat") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe Token
   -> Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe Token)
-> XParse
     (Maybe TimeOnly
      -> Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"fine") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)
        XParse
  (Maybe TimeOnly
   -> Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe TimeOnly)
-> XParse
     (Maybe YesNo
      -> Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeOnly -> XParse (Maybe TimeOnly)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"time-only") XParse String -> (String -> XParse TimeOnly) -> XParse TimeOnly
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeOnly
parseTimeOnly)
        XParse
  (Maybe YesNo
   -> Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe RotationDegrees
      -> Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"pizzicato") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe RotationDegrees
   -> Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe RotationDegrees
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"pan") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe RotationDegrees
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"elevation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe YesNoNumber)
-> XParse
     (Maybe YesNoNumber
      -> Maybe YesNoNumber
      -> Maybe ID
      -> [SeqSound]
      -> Maybe Offset
      -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNoNumber -> XParse (Maybe YesNoNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"damper-pedal") XParse String
-> (String -> XParse YesNoNumber) -> XParse YesNoNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNoNumber
parseYesNoNumber)
        XParse
  (Maybe YesNoNumber
   -> Maybe YesNoNumber
   -> Maybe ID
   -> [SeqSound]
   -> Maybe Offset
   -> Sound)
-> XParse (Maybe YesNoNumber)
-> XParse
     (Maybe YesNoNumber
      -> Maybe ID -> [SeqSound] -> Maybe Offset -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNoNumber -> XParse (Maybe YesNoNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"soft-pedal") XParse String
-> (String -> XParse YesNoNumber) -> XParse YesNoNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNoNumber
parseYesNoNumber)
        XParse
  (Maybe YesNoNumber
   -> Maybe ID -> [SeqSound] -> Maybe Offset -> Sound)
-> XParse (Maybe YesNoNumber)
-> XParse (Maybe ID -> [SeqSound] -> Maybe Offset -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNoNumber -> XParse (Maybe YesNoNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"sostenuto-pedal") XParse String
-> (String -> XParse YesNoNumber) -> XParse YesNoNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNoNumber
parseYesNoNumber)
        XParse (Maybe ID -> [SeqSound] -> Maybe Offset -> Sound)
-> XParse (Maybe ID)
-> XParse ([SeqSound] -> Maybe Offset -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([SeqSound] -> Maybe Offset -> Sound)
-> XParse [SeqSound] -> XParse (Maybe Offset -> Sound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqSound -> XParse [SeqSound]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse SeqSound
parseSeqSound)
        XParse (Maybe Offset -> Sound)
-> XParse (Maybe Offset) -> XParse Sound
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Offset -> XParse (Maybe Offset)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Offset -> XParse Offset
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"offset") (XParse Offset
parseOffset))

-- | Smart constructor for 'Sound'
mkSound :: Sound
mkSound :: Sound
mkSound = Maybe NonNegativeDecimal
-> Maybe NonNegativeDecimal
-> Maybe YesNo
-> Maybe Token
-> Maybe Token
-> Maybe Token
-> Maybe Token
-> Maybe Divisions
-> Maybe YesNo
-> Maybe Token
-> Maybe TimeOnly
-> Maybe YesNo
-> Maybe RotationDegrees
-> Maybe RotationDegrees
-> Maybe YesNoNumber
-> Maybe YesNoNumber
-> Maybe YesNoNumber
-> Maybe ID
-> [SeqSound]
-> Maybe Offset
-> Sound
Sound Maybe NonNegativeDecimal
forall a. Maybe a
Nothing Maybe NonNegativeDecimal
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing Maybe TimeOnly
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe YesNoNumber
forall a. Maybe a
Nothing Maybe YesNoNumber
forall a. Maybe a
Nothing Maybe YesNoNumber
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing [] Maybe Offset
forall a. Maybe a
Nothing

-- | @staff-details@ /(complex)/
--
-- The staff-details element is used to indicate different types of staves. The optional number attribute specifies the staff number from top to bottom on the system, as with clef. The print-object attribute is used to indicate when a staff is not printed in a part, usually in large scores where empty parts are omitted. It is yes by default. If print-spacing is yes while print-object is no, the score is printed in cutaway format where vertical space is left for the empty part.
data StaffDetails = 
      StaffDetails {
          StaffDetails -> Maybe StaffNumber
staffDetailsNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , StaffDetails -> Maybe ShowFrets
staffDetailsShowFrets :: (Maybe ShowFrets) -- ^ /show-frets/ attribute
        , StaffDetails -> Maybe YesNo
staffDetailsPrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , StaffDetails -> Maybe YesNo
staffDetailsPrintSpacing :: (Maybe YesNo) -- ^ /print-spacing/ attribute
        , StaffDetails -> Maybe StaffType
staffDetailsStaffType :: (Maybe StaffType) -- ^ /staff-type/ child element
        , StaffDetails -> Maybe NonNegativeInteger
staffDetailsStaffLines :: (Maybe NonNegativeInteger) -- ^ /staff-lines/ child element
        , StaffDetails -> [StaffTuning]
staffDetailsStaffTuning :: [StaffTuning] -- ^ /staff-tuning/ child element
        , StaffDetails -> Maybe NonNegativeInteger
staffDetailsCapo :: (Maybe NonNegativeInteger) -- ^ /capo/ child element
        , StaffDetails -> Maybe NonNegativeDecimal
staffDetailsStaffSize :: (Maybe NonNegativeDecimal) -- ^ /staff-size/ child element
       }
    deriving (StaffDetails -> StaffDetails -> Bool
(StaffDetails -> StaffDetails -> Bool)
-> (StaffDetails -> StaffDetails -> Bool) -> Eq StaffDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffDetails -> StaffDetails -> Bool
$c/= :: StaffDetails -> StaffDetails -> Bool
== :: StaffDetails -> StaffDetails -> Bool
$c== :: StaffDetails -> StaffDetails -> Bool
Eq,Typeable,(forall x. StaffDetails -> Rep StaffDetails x)
-> (forall x. Rep StaffDetails x -> StaffDetails)
-> Generic StaffDetails
forall x. Rep StaffDetails x -> StaffDetails
forall x. StaffDetails -> Rep StaffDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffDetails x -> StaffDetails
$cfrom :: forall x. StaffDetails -> Rep StaffDetails x
Generic,Int -> StaffDetails -> ShowS
[StaffDetails] -> ShowS
StaffDetails -> String
(Int -> StaffDetails -> ShowS)
-> (StaffDetails -> String)
-> ([StaffDetails] -> ShowS)
-> Show StaffDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffDetails] -> ShowS
$cshowList :: [StaffDetails] -> ShowS
show :: StaffDetails -> String
$cshow :: StaffDetails -> String
showsPrec :: Int -> StaffDetails -> ShowS
$cshowsPrec :: Int -> StaffDetails -> ShowS
Show)
instance EmitXml StaffDetails where
    emitXml :: StaffDetails -> XmlRep
emitXml (StaffDetails Maybe StaffNumber
a Maybe ShowFrets
b Maybe YesNo
c Maybe YesNo
d Maybe StaffType
e Maybe NonNegativeInteger
f [StaffTuning]
g Maybe NonNegativeInteger
h Maybe NonNegativeDecimal
i) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ShowFrets -> XmlRep) -> Maybe ShowFrets -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show-frets" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ShowFrets -> XmlRep) -> ShowFrets -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowFrets -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ShowFrets
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d])
        ([XmlRep -> (StaffType -> XmlRep) -> Maybe StaffType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StaffType -> XmlRep) -> StaffType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffType
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeInteger -> XmlRep)
-> Maybe NonNegativeInteger
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-lines" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeInteger -> XmlRep) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeInteger
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (StaffTuning -> XmlRep) -> [StaffTuning] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-tuning" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffTuning -> XmlRep) -> StaffTuning -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffTuning -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [StaffTuning]
g [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeInteger -> XmlRep)
-> Maybe NonNegativeInteger
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"capo" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeInteger -> XmlRep) -> NonNegativeInteger -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeInteger
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NonNegativeDecimal -> XmlRep)
-> Maybe NonNegativeDecimal
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NonNegativeDecimal -> XmlRep) -> NonNegativeDecimal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NonNegativeDecimal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NonNegativeDecimal
i])
parseStaffDetails :: P.XParse StaffDetails
parseStaffDetails :: XParse StaffDetails
parseStaffDetails = 
      Maybe StaffNumber
-> Maybe ShowFrets
-> Maybe YesNo
-> Maybe YesNo
-> Maybe StaffType
-> Maybe NonNegativeInteger
-> [StaffTuning]
-> Maybe NonNegativeInteger
-> Maybe NonNegativeDecimal
-> StaffDetails
StaffDetails
        (Maybe StaffNumber
 -> Maybe ShowFrets
 -> Maybe YesNo
 -> Maybe YesNo
 -> Maybe StaffType
 -> Maybe NonNegativeInteger
 -> [StaffTuning]
 -> Maybe NonNegativeInteger
 -> Maybe NonNegativeDecimal
 -> StaffDetails)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe ShowFrets
      -> Maybe YesNo
      -> Maybe YesNo
      -> Maybe StaffType
      -> Maybe NonNegativeInteger
      -> [StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe ShowFrets
   -> Maybe YesNo
   -> Maybe YesNo
   -> Maybe StaffType
   -> Maybe NonNegativeInteger
   -> [StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse (Maybe ShowFrets)
-> XParse
     (Maybe YesNo
      -> Maybe YesNo
      -> Maybe StaffType
      -> Maybe NonNegativeInteger
      -> [StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ShowFrets -> XParse (Maybe ShowFrets)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"show-frets") XParse String -> (String -> XParse ShowFrets) -> XParse ShowFrets
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ShowFrets
parseShowFrets)
        XParse
  (Maybe YesNo
   -> Maybe YesNo
   -> Maybe StaffType
   -> Maybe NonNegativeInteger
   -> [StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe YesNo
      -> Maybe StaffType
      -> Maybe NonNegativeInteger
      -> [StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe YesNo
   -> Maybe StaffType
   -> Maybe NonNegativeInteger
   -> [StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe StaffType
      -> Maybe NonNegativeInteger
      -> [StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-spacing") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe StaffType
   -> Maybe NonNegativeInteger
   -> [StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse (Maybe StaffType)
-> XParse
     (Maybe NonNegativeInteger
      -> [StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffType -> XParse (Maybe StaffType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse StaffType -> XParse StaffType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-type") (XParse String
P.xtext XParse String -> (String -> XParse StaffType) -> XParse StaffType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffType
parseStaffType))
        XParse
  (Maybe NonNegativeInteger
   -> [StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse (Maybe NonNegativeInteger)
-> XParse
     ([StaffTuning]
      -> Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal
      -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeInteger -> XParse (Maybe NonNegativeInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-lines") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse
  ([StaffTuning]
   -> Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal
   -> StaffDetails)
-> XParse [StaffTuning]
-> XParse
     (Maybe NonNegativeInteger
      -> Maybe NonNegativeDecimal -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffTuning -> XParse [StaffTuning]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse StaffTuning -> XParse StaffTuning
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-tuning") (XParse StaffTuning
parseStaffTuning))
        XParse
  (Maybe NonNegativeInteger
   -> Maybe NonNegativeDecimal -> StaffDetails)
-> XParse (Maybe NonNegativeInteger)
-> XParse (Maybe NonNegativeDecimal -> StaffDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeInteger -> XParse (Maybe NonNegativeInteger)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"capo") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse (Maybe NonNegativeDecimal -> StaffDetails)
-> XParse (Maybe NonNegativeDecimal) -> XParse StaffDetails
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NonNegativeDecimal -> XParse (Maybe NonNegativeDecimal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse NonNegativeDecimal -> XParse NonNegativeDecimal
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-size") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeDecimal)
-> XParse NonNegativeDecimal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeDecimal
parseNonNegativeDecimal))

-- | Smart constructor for 'StaffDetails'
mkStaffDetails :: StaffDetails
mkStaffDetails :: StaffDetails
mkStaffDetails = Maybe StaffNumber
-> Maybe ShowFrets
-> Maybe YesNo
-> Maybe YesNo
-> Maybe StaffType
-> Maybe NonNegativeInteger
-> [StaffTuning]
-> Maybe NonNegativeInteger
-> Maybe NonNegativeDecimal
-> StaffDetails
StaffDetails Maybe StaffNumber
forall a. Maybe a
Nothing Maybe ShowFrets
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe StaffType
forall a. Maybe a
Nothing Maybe NonNegativeInteger
forall a. Maybe a
Nothing [] Maybe NonNegativeInteger
forall a. Maybe a
Nothing Maybe NonNegativeDecimal
forall a. Maybe a
Nothing

-- | @staff-divide@ /(complex)/
--
-- The staff-divide element represents the staff division arrow symbols found at SMuFL code points U+E00B, U+E00C, and U+E00D.
data StaffDivide = 
      StaffDivide {
          StaffDivide -> StaffDivideSymbol
staffDivideType :: StaffDivideSymbol -- ^ /type/ attribute
        , StaffDivide -> Maybe Tenths
staffDivideDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , StaffDivide -> Maybe Tenths
staffDivideDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , StaffDivide -> Maybe Tenths
staffDivideRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , StaffDivide -> Maybe Tenths
staffDivideRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , StaffDivide -> Maybe CommaSeparatedText
staffDivideFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , StaffDivide -> Maybe FontStyle
staffDivideFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , StaffDivide -> Maybe FontSize
staffDivideFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , StaffDivide -> Maybe FontWeight
staffDivideFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , StaffDivide -> Maybe Color
staffDivideColor :: (Maybe Color) -- ^ /color/ attribute
        , StaffDivide -> Maybe LeftCenterRight
staffDivideHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , StaffDivide -> Maybe Valign
staffDivideValign :: (Maybe Valign) -- ^ /valign/ attribute
        , StaffDivide -> Maybe ID
staffDivideId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (StaffDivide -> StaffDivide -> Bool
(StaffDivide -> StaffDivide -> Bool)
-> (StaffDivide -> StaffDivide -> Bool) -> Eq StaffDivide
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffDivide -> StaffDivide -> Bool
$c/= :: StaffDivide -> StaffDivide -> Bool
== :: StaffDivide -> StaffDivide -> Bool
$c== :: StaffDivide -> StaffDivide -> Bool
Eq,Typeable,(forall x. StaffDivide -> Rep StaffDivide x)
-> (forall x. Rep StaffDivide x -> StaffDivide)
-> Generic StaffDivide
forall x. Rep StaffDivide x -> StaffDivide
forall x. StaffDivide -> Rep StaffDivide x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffDivide x -> StaffDivide
$cfrom :: forall x. StaffDivide -> Rep StaffDivide x
Generic,Int -> StaffDivide -> ShowS
[StaffDivide] -> ShowS
StaffDivide -> String
(Int -> StaffDivide -> ShowS)
-> (StaffDivide -> String)
-> ([StaffDivide] -> ShowS)
-> Show StaffDivide
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffDivide] -> ShowS
$cshowList :: [StaffDivide] -> ShowS
show :: StaffDivide -> String
$cshow :: StaffDivide -> String
showsPrec :: Int -> StaffDivide -> ShowS
$cshowsPrec :: Int -> StaffDivide -> ShowS
Show)
instance EmitXml StaffDivide where
    emitXml :: StaffDivide -> XmlRep
emitXml (StaffDivide StaffDivideSymbol
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StaffDivideSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StaffDivideSymbol
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseStaffDivide :: P.XParse StaffDivide
parseStaffDivide :: XParse StaffDivide
parseStaffDivide = 
      StaffDivideSymbol
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> StaffDivide
StaffDivide
        (StaffDivideSymbol
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> StaffDivide)
-> XParse StaffDivideSymbol
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StaffDivideSymbol) -> XParse StaffDivideSymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffDivideSymbol
parseStaffDivideSymbol)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StaffDivide)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StaffDivide)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> StaffDivide)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> StaffDivide)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> StaffDivide)
-> XParse (Maybe ID) -> XParse StaffDivide
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'StaffDivide'
mkStaffDivide :: StaffDivideSymbol -> StaffDivide
mkStaffDivide :: StaffDivideSymbol -> StaffDivide
mkStaffDivide StaffDivideSymbol
a = StaffDivideSymbol
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> StaffDivide
StaffDivide StaffDivideSymbol
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @staff-layout@ /(complex)/
--
-- Staff layout includes the vertical distance from the bottom line of the previous staff in this system to the top line of the staff specified by the number attribute. The optional number attribute refers to staff numbers within the part, from top to bottom on the system. A value of 1 is assumed if not present. When used in the defaults element, the values apply to all parts. This value is ignored for the first staff in a system.
data StaffLayout = 
      StaffLayout {
          StaffLayout -> Maybe StaffNumber
staffLayoutNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , StaffLayout -> Maybe Tenths
staffLayoutStaffDistance :: (Maybe Tenths) -- ^ /staff-distance/ child element
       }
    deriving (StaffLayout -> StaffLayout -> Bool
(StaffLayout -> StaffLayout -> Bool)
-> (StaffLayout -> StaffLayout -> Bool) -> Eq StaffLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffLayout -> StaffLayout -> Bool
$c/= :: StaffLayout -> StaffLayout -> Bool
== :: StaffLayout -> StaffLayout -> Bool
$c== :: StaffLayout -> StaffLayout -> Bool
Eq,Typeable,(forall x. StaffLayout -> Rep StaffLayout x)
-> (forall x. Rep StaffLayout x -> StaffLayout)
-> Generic StaffLayout
forall x. Rep StaffLayout x -> StaffLayout
forall x. StaffLayout -> Rep StaffLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffLayout x -> StaffLayout
$cfrom :: forall x. StaffLayout -> Rep StaffLayout x
Generic,Int -> StaffLayout -> ShowS
[StaffLayout] -> ShowS
StaffLayout -> String
(Int -> StaffLayout -> ShowS)
-> (StaffLayout -> String)
-> ([StaffLayout] -> ShowS)
-> Show StaffLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffLayout] -> ShowS
$cshowList :: [StaffLayout] -> ShowS
show :: StaffLayout -> String
$cshow :: StaffLayout -> String
showsPrec :: Int -> StaffLayout -> ShowS
$cshowsPrec :: Int -> StaffLayout -> ShowS
Show)
instance EmitXml StaffLayout where
    emitXml :: StaffLayout -> XmlRep
emitXml (StaffLayout Maybe StaffNumber
a Maybe Tenths
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a])
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-distance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b])
parseStaffLayout :: P.XParse StaffLayout
parseStaffLayout :: XParse StaffLayout
parseStaffLayout = 
      Maybe StaffNumber -> Maybe Tenths -> StaffLayout
StaffLayout
        (Maybe StaffNumber -> Maybe Tenths -> StaffLayout)
-> XParse (Maybe StaffNumber)
-> XParse (Maybe Tenths -> StaffLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse (Maybe Tenths -> StaffLayout)
-> XParse (Maybe Tenths) -> XParse StaffLayout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-distance") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'StaffLayout'
mkStaffLayout :: StaffLayout
mkStaffLayout :: StaffLayout
mkStaffLayout = Maybe StaffNumber -> Maybe Tenths -> StaffLayout
StaffLayout Maybe StaffNumber
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing

-- | @staff-tuning@ /(complex)/
--
-- The staff-tuning type specifies the open, non-capo tuning of the lines on a tablature staff.
data StaffTuning = 
      StaffTuning {
          StaffTuning -> Maybe StaffLine
staffTuningLine :: (Maybe StaffLine) -- ^ /line/ attribute
        , StaffTuning -> Tuning
staffTuningTuning :: Tuning
       }
    deriving (StaffTuning -> StaffTuning -> Bool
(StaffTuning -> StaffTuning -> Bool)
-> (StaffTuning -> StaffTuning -> Bool) -> Eq StaffTuning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StaffTuning -> StaffTuning -> Bool
$c/= :: StaffTuning -> StaffTuning -> Bool
== :: StaffTuning -> StaffTuning -> Bool
$c== :: StaffTuning -> StaffTuning -> Bool
Eq,Typeable,(forall x. StaffTuning -> Rep StaffTuning x)
-> (forall x. Rep StaffTuning x -> StaffTuning)
-> Generic StaffTuning
forall x. Rep StaffTuning x -> StaffTuning
forall x. StaffTuning -> Rep StaffTuning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StaffTuning x -> StaffTuning
$cfrom :: forall x. StaffTuning -> Rep StaffTuning x
Generic,Int -> StaffTuning -> ShowS
[StaffTuning] -> ShowS
StaffTuning -> String
(Int -> StaffTuning -> ShowS)
-> (StaffTuning -> String)
-> ([StaffTuning] -> ShowS)
-> Show StaffTuning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaffTuning] -> ShowS
$cshowList :: [StaffTuning] -> ShowS
show :: StaffTuning -> String
$cshow :: StaffTuning -> String
showsPrec :: Int -> StaffTuning -> ShowS
$cshowsPrec :: Int -> StaffTuning -> ShowS
Show)
instance EmitXml StaffTuning where
    emitXml :: StaffTuning -> XmlRep
emitXml (StaffTuning Maybe StaffLine
a Tuning
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffLine -> XmlRep) -> Maybe StaffLine -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StaffLine -> XmlRep) -> StaffLine -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffLine
a])
        ([Tuning -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tuning
b])
parseStaffTuning :: P.XParse StaffTuning
parseStaffTuning :: XParse StaffTuning
parseStaffTuning = 
      Maybe StaffLine -> Tuning -> StaffTuning
StaffTuning
        (Maybe StaffLine -> Tuning -> StaffTuning)
-> XParse (Maybe StaffLine) -> XParse (Tuning -> StaffTuning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffLine -> XParse (Maybe StaffLine)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line") XParse String -> (String -> XParse StaffLine) -> XParse StaffLine
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffLine
parseStaffLine)
        XParse (Tuning -> StaffTuning)
-> XParse Tuning -> XParse StaffTuning
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tuning
parseTuning

-- | Smart constructor for 'StaffTuning'
mkStaffTuning :: Tuning -> StaffTuning
mkStaffTuning :: Tuning -> StaffTuning
mkStaffTuning Tuning
b = Maybe StaffLine -> Tuning -> StaffTuning
StaffTuning Maybe StaffLine
forall a. Maybe a
Nothing Tuning
b

-- | @stem@ /(complex)/
--
-- Stems can be down, up, none, or double. For down and up stems, the position attributes can be used to specify stem length. The relative values specify the end of the stem relative to the program default. Default values specify an absolute end stem position. Negative values of relative-y that would flip a stem instead of shortening it are ignored. A stem element associated with a rest refers to a stemlet.
data Stem = 
      Stem {
          Stem -> StemValue
stemStemValue :: StemValue -- ^ text content
        , Stem -> Maybe Tenths
stemDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Stem -> Maybe Tenths
stemDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Stem -> Maybe Tenths
stemRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Stem -> Maybe Tenths
stemRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Stem -> Maybe Color
stemColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (Stem -> Stem -> Bool
(Stem -> Stem -> Bool) -> (Stem -> Stem -> Bool) -> Eq Stem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stem -> Stem -> Bool
$c/= :: Stem -> Stem -> Bool
== :: Stem -> Stem -> Bool
$c== :: Stem -> Stem -> Bool
Eq,Typeable,(forall x. Stem -> Rep Stem x)
-> (forall x. Rep Stem x -> Stem) -> Generic Stem
forall x. Rep Stem x -> Stem
forall x. Stem -> Rep Stem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stem x -> Stem
$cfrom :: forall x. Stem -> Rep Stem x
Generic,Int -> Stem -> ShowS
[Stem] -> ShowS
Stem -> String
(Int -> Stem -> ShowS)
-> (Stem -> String) -> ([Stem] -> ShowS) -> Show Stem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stem] -> ShowS
$cshowList :: [Stem] -> ShowS
show :: Stem -> String
$cshow :: Stem -> String
showsPrec :: Int -> Stem -> ShowS
$cshowsPrec :: Int -> Stem -> ShowS
Show)
instance EmitXml Stem where
    emitXml :: Stem -> XmlRep
emitXml (Stem StemValue
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (StemValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StemValue
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseStem :: P.XParse Stem
parseStem :: XParse Stem
parseStem = 
      StemValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Stem
Stem
        (StemValue
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Stem)
-> XParse StemValue
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Stem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse StemValue) -> XParse StemValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StemValue
parseStemValue)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Stem)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> Stem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe Tenths -> Maybe Color -> Stem)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Stem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Stem)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> Stem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> Stem)
-> XParse (Maybe Tenths) -> XParse (Maybe Color -> Stem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> Stem) -> XParse (Maybe Color) -> XParse Stem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'Stem'
mkStem :: StemValue -> Stem
mkStem :: StemValue -> Stem
mkStem StemValue
a = StemValue
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Stem
Stem StemValue
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @stick@ /(complex)/
--
-- The stick type represents pictograms where the material of the stick, mallet, or beater is included.The parentheses and dashed-circle attributes indicate the presence of these marks around the round beater part of a pictogram. Values for these attributes are "no" if not present.
data Stick = 
      Stick {
          Stick -> Maybe TipDirection
stickTip :: (Maybe TipDirection) -- ^ /tip/ attribute
        , Stick -> Maybe YesNo
stickParentheses :: (Maybe YesNo) -- ^ /parentheses/ attribute
        , Stick -> Maybe YesNo
stickDashedCircle :: (Maybe YesNo) -- ^ /dashed-circle/ attribute
        , Stick -> StickType
stickStickType :: StickType -- ^ /stick-type/ child element
        , Stick -> StickMaterial
stickStickMaterial :: StickMaterial -- ^ /stick-material/ child element
       }
    deriving (Stick -> Stick -> Bool
(Stick -> Stick -> Bool) -> (Stick -> Stick -> Bool) -> Eq Stick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stick -> Stick -> Bool
$c/= :: Stick -> Stick -> Bool
== :: Stick -> Stick -> Bool
$c== :: Stick -> Stick -> Bool
Eq,Typeable,(forall x. Stick -> Rep Stick x)
-> (forall x. Rep Stick x -> Stick) -> Generic Stick
forall x. Rep Stick x -> Stick
forall x. Stick -> Rep Stick x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stick x -> Stick
$cfrom :: forall x. Stick -> Rep Stick x
Generic,Int -> Stick -> ShowS
[Stick] -> ShowS
Stick -> String
(Int -> Stick -> ShowS)
-> (Stick -> String) -> ([Stick] -> ShowS) -> Show Stick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stick] -> ShowS
$cshowList :: [Stick] -> ShowS
show :: Stick -> String
$cshow :: Stick -> String
showsPrec :: Int -> Stick -> ShowS
$cshowsPrec :: Int -> Stick -> ShowS
Show)
instance EmitXml Stick where
    emitXml :: Stick -> XmlRep
emitXml (Stick Maybe TipDirection
a Maybe YesNo
b Maybe YesNo
c StickType
d StickMaterial
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (TipDirection -> XmlRep) -> Maybe TipDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"tip" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TipDirection -> XmlRep) -> TipDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TipDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TipDirection
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"parentheses" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dashed-circle" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c])
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stick-type" Maybe String
forall a. Maybe a
Nothing) (StickType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StickType
d)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stick-material" Maybe String
forall a. Maybe a
Nothing) (StickMaterial -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StickMaterial
e)])
parseStick :: P.XParse Stick
parseStick :: XParse Stick
parseStick = 
      Maybe TipDirection
-> Maybe YesNo
-> Maybe YesNo
-> StickType
-> StickMaterial
-> Stick
Stick
        (Maybe TipDirection
 -> Maybe YesNo
 -> Maybe YesNo
 -> StickType
 -> StickMaterial
 -> Stick)
-> XParse (Maybe TipDirection)
-> XParse
     (Maybe YesNo -> Maybe YesNo -> StickType -> StickMaterial -> Stick)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TipDirection -> XParse (Maybe TipDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"tip") XParse String
-> (String -> XParse TipDirection) -> XParse TipDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TipDirection
parseTipDirection)
        XParse
  (Maybe YesNo -> Maybe YesNo -> StickType -> StickMaterial -> Stick)
-> XParse (Maybe YesNo)
-> XParse (Maybe YesNo -> StickType -> StickMaterial -> Stick)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"parentheses") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe YesNo -> StickType -> StickMaterial -> Stick)
-> XParse (Maybe YesNo)
-> XParse (StickType -> StickMaterial -> Stick)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dashed-circle") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (StickType -> StickMaterial -> Stick)
-> XParse StickType -> XParse (StickMaterial -> Stick)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse StickType -> XParse StickType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stick-type") (XParse String
P.xtext XParse String -> (String -> XParse StickType) -> XParse StickType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StickType
parseStickType))
        XParse (StickMaterial -> Stick)
-> XParse StickMaterial -> XParse Stick
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse StickMaterial -> XParse StickMaterial
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stick-material") (XParse String
P.xtext XParse String
-> (String -> XParse StickMaterial) -> XParse StickMaterial
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StickMaterial
parseStickMaterial))

-- | Smart constructor for 'Stick'
mkStick :: StickType -> StickMaterial -> Stick
mkStick :: StickType -> StickMaterial -> Stick
mkStick StickType
d StickMaterial
e = Maybe TipDirection
-> Maybe YesNo
-> Maybe YesNo
-> StickType
-> StickMaterial
-> Stick
Stick Maybe TipDirection
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing StickType
d StickMaterial
e

-- | @string@ /(complex)/
--
-- The string type is used with tablature notation, regular notation (where it is often circled), and chord diagrams. String numbers start with 1 for the highest pitched full-length string.
data CmpString = 
      CmpString {
          CmpString -> StringNumber
stringStringNumber :: StringNumber -- ^ text content
        , CmpString -> Maybe Tenths
stringDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , CmpString -> Maybe Tenths
stringDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , CmpString -> Maybe Tenths
stringRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , CmpString -> Maybe Tenths
stringRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , CmpString -> Maybe CommaSeparatedText
stringFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , CmpString -> Maybe FontStyle
stringFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , CmpString -> Maybe FontSize
stringFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , CmpString -> Maybe FontWeight
stringFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , CmpString -> Maybe Color
stringColor :: (Maybe Color) -- ^ /color/ attribute
        , CmpString -> Maybe AboveBelow
stringPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (CmpString -> CmpString -> Bool
(CmpString -> CmpString -> Bool)
-> (CmpString -> CmpString -> Bool) -> Eq CmpString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpString -> CmpString -> Bool
$c/= :: CmpString -> CmpString -> Bool
== :: CmpString -> CmpString -> Bool
$c== :: CmpString -> CmpString -> Bool
Eq,Typeable,(forall x. CmpString -> Rep CmpString x)
-> (forall x. Rep CmpString x -> CmpString) -> Generic CmpString
forall x. Rep CmpString x -> CmpString
forall x. CmpString -> Rep CmpString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpString x -> CmpString
$cfrom :: forall x. CmpString -> Rep CmpString x
Generic,Int -> CmpString -> ShowS
[CmpString] -> ShowS
CmpString -> String
(Int -> CmpString -> ShowS)
-> (CmpString -> String)
-> ([CmpString] -> ShowS)
-> Show CmpString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpString] -> ShowS
$cshowList :: [CmpString] -> ShowS
show :: CmpString -> String
$cshow :: CmpString -> String
showsPrec :: Int -> CmpString -> ShowS
$cshowsPrec :: Int -> CmpString -> ShowS
Show)
instance EmitXml CmpString where
    emitXml :: CmpString -> XmlRep
emitXml (CmpString StringNumber
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe AboveBelow
k) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (StringNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StringNumber
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k])
        []
parseCmpString :: P.XParse CmpString
parseCmpString :: XParse CmpString
parseCmpString = 
      StringNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> CmpString
CmpString
        (StringNumber
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> CmpString)
-> XParse StringNumber
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse StringNumber) -> XParse StringNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StringNumber
parseStringNumber)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> CmpString)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> CmpString)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> CmpString)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> CmpString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> CmpString)
-> XParse (Maybe AboveBelow) -> XParse CmpString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'CmpString'
mkCmpString :: StringNumber -> CmpString
mkCmpString :: StringNumber -> CmpString
mkCmpString StringNumber
a = StringNumber
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> CmpString
CmpString StringNumber
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @string-mute@ /(complex)/
--
-- The string-mute type represents string mute on and mute off symbols.
data StringMute = 
      StringMute {
          StringMute -> OnOff
stringMuteType :: OnOff -- ^ /type/ attribute
        , StringMute -> Maybe Tenths
stringMuteDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , StringMute -> Maybe Tenths
stringMuteDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , StringMute -> Maybe Tenths
stringMuteRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , StringMute -> Maybe Tenths
stringMuteRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , StringMute -> Maybe CommaSeparatedText
stringMuteFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , StringMute -> Maybe FontStyle
stringMuteFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , StringMute -> Maybe FontSize
stringMuteFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , StringMute -> Maybe FontWeight
stringMuteFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , StringMute -> Maybe Color
stringMuteColor :: (Maybe Color) -- ^ /color/ attribute
        , StringMute -> Maybe LeftCenterRight
stringMuteHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , StringMute -> Maybe Valign
stringMuteValign :: (Maybe Valign) -- ^ /valign/ attribute
        , StringMute -> Maybe ID
stringMuteId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (StringMute -> StringMute -> Bool
(StringMute -> StringMute -> Bool)
-> (StringMute -> StringMute -> Bool) -> Eq StringMute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringMute -> StringMute -> Bool
$c/= :: StringMute -> StringMute -> Bool
== :: StringMute -> StringMute -> Bool
$c== :: StringMute -> StringMute -> Bool
Eq,Typeable,(forall x. StringMute -> Rep StringMute x)
-> (forall x. Rep StringMute x -> StringMute) -> Generic StringMute
forall x. Rep StringMute x -> StringMute
forall x. StringMute -> Rep StringMute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StringMute x -> StringMute
$cfrom :: forall x. StringMute -> Rep StringMute x
Generic,Int -> StringMute -> ShowS
[StringMute] -> ShowS
StringMute -> String
(Int -> StringMute -> ShowS)
-> (StringMute -> String)
-> ([StringMute] -> ShowS)
-> Show StringMute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringMute] -> ShowS
$cshowList :: [StringMute] -> ShowS
show :: StringMute -> String
$cshow :: StringMute -> String
showsPrec :: Int -> StringMute -> ShowS
$cshowsPrec :: Int -> StringMute -> ShowS
Show)
instance EmitXml StringMute where
    emitXml :: StringMute -> XmlRep
emitXml (StringMute OnOff
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j Maybe LeftCenterRight
k Maybe Valign
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (OnOff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OnOff
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseStringMute :: P.XParse StringMute
parseStringMute :: XParse StringMute
parseStringMute = 
      OnOff
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> StringMute
StringMute
        (OnOff
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe ID
 -> StringMute)
-> XParse OnOff
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse OnOff) -> XParse OnOff
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse OnOff
parseOnOff)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe ID
      -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe ID
   -> StringMute)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StringMute)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight -> Maybe Valign -> Maybe ID -> StringMute)
-> XParse (Maybe LeftCenterRight)
-> XParse (Maybe Valign -> Maybe ID -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe ID -> StringMute)
-> XParse (Maybe Valign) -> XParse (Maybe ID -> StringMute)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe ID -> StringMute)
-> XParse (Maybe ID) -> XParse StringMute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'StringMute'
mkStringMute :: OnOff -> StringMute
mkStringMute :: OnOff -> StringMute
mkStringMute OnOff
a = OnOff
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe ID
-> StringMute
StringMute OnOff
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @strong-accent@ /(complex)/
--
-- The strong-accent type indicates a vertical accent mark. The type attribute indicates if the point of the accent is down or up.
data StrongAccent = 
      StrongAccent {
          StrongAccent -> StrongAccent
strongAccentEmptyPlacement :: StrongAccent
        , StrongAccent -> Maybe UpDown
strongAccentType :: (Maybe UpDown) -- ^ /type/ attribute
       }
    deriving (StrongAccent -> StrongAccent -> Bool
(StrongAccent -> StrongAccent -> Bool)
-> (StrongAccent -> StrongAccent -> Bool) -> Eq StrongAccent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrongAccent -> StrongAccent -> Bool
$c/= :: StrongAccent -> StrongAccent -> Bool
== :: StrongAccent -> StrongAccent -> Bool
$c== :: StrongAccent -> StrongAccent -> Bool
Eq,Typeable,(forall x. StrongAccent -> Rep StrongAccent x)
-> (forall x. Rep StrongAccent x -> StrongAccent)
-> Generic StrongAccent
forall x. Rep StrongAccent x -> StrongAccent
forall x. StrongAccent -> Rep StrongAccent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StrongAccent x -> StrongAccent
$cfrom :: forall x. StrongAccent -> Rep StrongAccent x
Generic,Int -> StrongAccent -> ShowS
[StrongAccent] -> ShowS
StrongAccent -> String
(Int -> StrongAccent -> ShowS)
-> (StrongAccent -> String)
-> ([StrongAccent] -> ShowS)
-> Show StrongAccent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StrongAccent] -> ShowS
$cshowList :: [StrongAccent] -> ShowS
show :: StrongAccent -> String
$cshow :: StrongAccent -> String
showsPrec :: Int -> StrongAccent -> ShowS
$cshowsPrec :: Int -> StrongAccent -> ShowS
Show)
instance EmitXml StrongAccent where
    emitXml :: StrongAccent -> XmlRep
emitXml (StrongAccent StrongAccent
a Maybe UpDown
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (UpDown -> XmlRep) -> Maybe UpDown -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (UpDown -> XmlRep) -> UpDown -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.UpDown -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe UpDown
b])
        ([StrongAccent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StrongAccent
a])
parseStrongAccent :: P.XParse StrongAccent
parseStrongAccent :: XParse StrongAccent
parseStrongAccent = 
      StrongAccent -> Maybe UpDown -> StrongAccent
StrongAccent
        (StrongAccent -> Maybe UpDown -> StrongAccent)
-> XParse StrongAccent -> XParse (Maybe UpDown -> StrongAccent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StrongAccent
parseStrongAccent
        XParse (Maybe UpDown -> StrongAccent)
-> XParse (Maybe UpDown) -> XParse StrongAccent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse UpDown -> XParse (Maybe UpDown)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse UpDown) -> XParse UpDown
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse UpDown
parseUpDown)

-- | Smart constructor for 'StrongAccent'
mkStrongAccent :: StrongAccent -> StrongAccent
mkStrongAccent :: StrongAccent -> StrongAccent
mkStrongAccent StrongAccent
a = StrongAccent -> Maybe UpDown -> StrongAccent
StrongAccent StrongAccent
a Maybe UpDown
forall a. Maybe a
Nothing

-- | @style-text@ /(complex)/
--
-- The style-text type represents a text element with a print-style attribute group.
data StyleText = 
      StyleText {
          StyleText -> String
styleTextString :: String -- ^ text content
        , StyleText -> Maybe Tenths
styleTextDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , StyleText -> Maybe Tenths
styleTextDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , StyleText -> Maybe Tenths
styleTextRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , StyleText -> Maybe Tenths
styleTextRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , StyleText -> Maybe CommaSeparatedText
styleTextFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , StyleText -> Maybe FontStyle
styleTextFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , StyleText -> Maybe FontSize
styleTextFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , StyleText -> Maybe FontWeight
styleTextFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , StyleText -> Maybe Color
styleTextColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (StyleText -> StyleText -> Bool
(StyleText -> StyleText -> Bool)
-> (StyleText -> StyleText -> Bool) -> Eq StyleText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleText -> StyleText -> Bool
$c/= :: StyleText -> StyleText -> Bool
== :: StyleText -> StyleText -> Bool
$c== :: StyleText -> StyleText -> Bool
Eq,Typeable,(forall x. StyleText -> Rep StyleText x)
-> (forall x. Rep StyleText x -> StyleText) -> Generic StyleText
forall x. Rep StyleText x -> StyleText
forall x. StyleText -> Rep StyleText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StyleText x -> StyleText
$cfrom :: forall x. StyleText -> Rep StyleText x
Generic,Int -> StyleText -> ShowS
[StyleText] -> ShowS
StyleText -> String
(Int -> StyleText -> ShowS)
-> (StyleText -> String)
-> ([StyleText] -> ShowS)
-> Show StyleText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleText] -> ShowS
$cshowList :: [StyleText] -> ShowS
show :: StyleText -> String
$cshow :: StyleText -> String
showsPrec :: Int -> StyleText -> ShowS
$cshowsPrec :: Int -> StyleText -> ShowS
Show)
instance EmitXml StyleText where
    emitXml :: StyleText -> XmlRep
emitXml (StyleText String
a Maybe Tenths
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe CommaSeparatedText
f Maybe FontStyle
g Maybe FontSize
h Maybe FontWeight
i Maybe Color
j) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
j])
        []
parseStyleText :: P.XParse StyleText
parseStyleText :: XParse StyleText
parseStyleText = 
      String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> StyleText
StyleText
        (String
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> StyleText)
-> XParse String
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> StyleText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> StyleText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> StyleText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> StyleText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> StyleText)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> StyleText)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> StyleText)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> StyleText)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> StyleText)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> StyleText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> StyleText)
-> XParse (Maybe Color) -> XParse StyleText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'StyleText'
mkStyleText :: String -> StyleText
mkStyleText :: String -> StyleText
mkStyleText String
a = String
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> StyleText
StyleText String
a Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @supports@ /(complex)/
--
-- The supports type indicates if a MusicXML encoding supports a particular MusicXML element. This is recommended for elements like beam, stem, and accidental, where the absence of an element is ambiguous if you do not know if the encoding supports that element. For Version 2.0, the supports element is expanded to allow programs to indicate support for particular attributes or particular values. This lets applications communicate, for example, that all system and/or page breaks are contained in the MusicXML file.
data Supports = 
      Supports {
          Supports -> YesNo
supportsType :: YesNo -- ^ /type/ attribute
        , Supports -> NMTOKEN
supportsElement :: NMTOKEN -- ^ /element/ attribute
        , Supports -> Maybe NMTOKEN
supportsAttribute :: (Maybe NMTOKEN) -- ^ /attribute/ attribute
        , Supports -> Maybe Token
supportsValue :: (Maybe Token) -- ^ /value/ attribute
       }
    deriving (Supports -> Supports -> Bool
(Supports -> Supports -> Bool)
-> (Supports -> Supports -> Bool) -> Eq Supports
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Supports -> Supports -> Bool
$c/= :: Supports -> Supports -> Bool
== :: Supports -> Supports -> Bool
$c== :: Supports -> Supports -> Bool
Eq,Typeable,(forall x. Supports -> Rep Supports x)
-> (forall x. Rep Supports x -> Supports) -> Generic Supports
forall x. Rep Supports x -> Supports
forall x. Supports -> Rep Supports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Supports x -> Supports
$cfrom :: forall x. Supports -> Rep Supports x
Generic,Int -> Supports -> ShowS
[Supports] -> ShowS
Supports -> String
(Int -> Supports -> ShowS)
-> (Supports -> String) -> ([Supports] -> ShowS) -> Show Supports
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Supports] -> ShowS
$cshowList :: [Supports] -> ShowS
show :: Supports -> String
$cshow :: Supports -> String
showsPrec :: Int -> Supports -> ShowS
$cshowsPrec :: Int -> Supports -> ShowS
Show)
instance EmitXml Supports where
    emitXml :: Supports -> XmlRep
emitXml (Supports YesNo
a NMTOKEN
b Maybe NMTOKEN
c Maybe Token
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml YesNo
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"element" Maybe String
forall a. Maybe a
Nothing) (NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NMTOKEN
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NMTOKEN -> XmlRep) -> Maybe NMTOKEN -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"attribute" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (NMTOKEN -> XmlRep) -> NMTOKEN -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NMTOKEN -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NMTOKEN
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"value" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
d])
        []
parseSupports :: P.XParse Supports
parseSupports :: XParse Supports
parseSupports = 
      YesNo -> NMTOKEN -> Maybe NMTOKEN -> Maybe Token -> Supports
Supports
        (YesNo -> NMTOKEN -> Maybe NMTOKEN -> Maybe Token -> Supports)
-> XParse YesNo
-> XParse (NMTOKEN -> Maybe NMTOKEN -> Maybe Token -> Supports)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (NMTOKEN -> Maybe NMTOKEN -> Maybe Token -> Supports)
-> XParse NMTOKEN
-> XParse (Maybe NMTOKEN -> Maybe Token -> Supports)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String
P.xattr (String -> QName
P.name String
"element") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse (Maybe NMTOKEN -> Maybe Token -> Supports)
-> XParse (Maybe NMTOKEN) -> XParse (Maybe Token -> Supports)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NMTOKEN -> XParse (Maybe NMTOKEN)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"attribute") XParse String -> (String -> XParse NMTOKEN) -> XParse NMTOKEN
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NMTOKEN
parseNMTOKEN)
        XParse (Maybe Token -> Supports)
-> XParse (Maybe Token) -> XParse Supports
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"value") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'Supports'
mkSupports :: YesNo -> NMTOKEN -> Supports
mkSupports :: YesNo -> NMTOKEN -> Supports
mkSupports YesNo
a NMTOKEN
b = YesNo -> NMTOKEN -> Maybe NMTOKEN -> Maybe Token -> Supports
Supports YesNo
a NMTOKEN
b Maybe NMTOKEN
forall a. Maybe a
Nothing Maybe Token
forall a. Maybe a
Nothing

-- | @system-dividers@ /(complex)/
--
-- The system-dividers element indicates the presence or absence of system dividers (also known as system separation marks) between systems displayed on the same page. Dividers on the left and right side of the page are controlled by the left-divider and right-divider elements respectively. The default vertical position is half the system-distance value from the top of the system that is below the divider. The default horizontal position is the left and right system margin, respectively.
-- 
-- When used in the print element, the system-dividers element affects the dividers that would appear between the current system and the previous system.
data SystemDividers = 
      SystemDividers {
          SystemDividers -> EmptyPrintObjectStyleAlign
systemDividersLeftDivider :: EmptyPrintObjectStyleAlign -- ^ /left-divider/ child element
        , SystemDividers -> EmptyPrintObjectStyleAlign
systemDividersRightDivider :: EmptyPrintObjectStyleAlign -- ^ /right-divider/ child element
       }
    deriving (SystemDividers -> SystemDividers -> Bool
(SystemDividers -> SystemDividers -> Bool)
-> (SystemDividers -> SystemDividers -> Bool) -> Eq SystemDividers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemDividers -> SystemDividers -> Bool
$c/= :: SystemDividers -> SystemDividers -> Bool
== :: SystemDividers -> SystemDividers -> Bool
$c== :: SystemDividers -> SystemDividers -> Bool
Eq,Typeable,(forall x. SystemDividers -> Rep SystemDividers x)
-> (forall x. Rep SystemDividers x -> SystemDividers)
-> Generic SystemDividers
forall x. Rep SystemDividers x -> SystemDividers
forall x. SystemDividers -> Rep SystemDividers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SystemDividers x -> SystemDividers
$cfrom :: forall x. SystemDividers -> Rep SystemDividers x
Generic,Int -> SystemDividers -> ShowS
[SystemDividers] -> ShowS
SystemDividers -> String
(Int -> SystemDividers -> ShowS)
-> (SystemDividers -> String)
-> ([SystemDividers] -> ShowS)
-> Show SystemDividers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemDividers] -> ShowS
$cshowList :: [SystemDividers] -> ShowS
show :: SystemDividers -> String
$cshow :: SystemDividers -> String
showsPrec :: Int -> SystemDividers -> ShowS
$cshowsPrec :: Int -> SystemDividers -> ShowS
Show)
instance EmitXml SystemDividers where
    emitXml :: SystemDividers -> XmlRep
emitXml (SystemDividers EmptyPrintObjectStyleAlign
a EmptyPrintObjectStyleAlign
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"left-divider" Maybe String
forall a. Maybe a
Nothing) (EmptyPrintObjectStyleAlign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPrintObjectStyleAlign
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"right-divider" Maybe String
forall a. Maybe a
Nothing) (EmptyPrintObjectStyleAlign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPrintObjectStyleAlign
b)])
parseSystemDividers :: P.XParse SystemDividers
parseSystemDividers :: XParse SystemDividers
parseSystemDividers = 
      EmptyPrintObjectStyleAlign
-> EmptyPrintObjectStyleAlign -> SystemDividers
SystemDividers
        (EmptyPrintObjectStyleAlign
 -> EmptyPrintObjectStyleAlign -> SystemDividers)
-> XParse EmptyPrintObjectStyleAlign
-> XParse (EmptyPrintObjectStyleAlign -> SystemDividers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse EmptyPrintObjectStyleAlign
-> XParse EmptyPrintObjectStyleAlign
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"left-divider") (XParse EmptyPrintObjectStyleAlign
parseEmptyPrintObjectStyleAlign))
        XParse (EmptyPrintObjectStyleAlign -> SystemDividers)
-> XParse EmptyPrintObjectStyleAlign -> XParse SystemDividers
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName
-> XParse EmptyPrintObjectStyleAlign
-> XParse EmptyPrintObjectStyleAlign
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"right-divider") (XParse EmptyPrintObjectStyleAlign
parseEmptyPrintObjectStyleAlign))

-- | Smart constructor for 'SystemDividers'
mkSystemDividers :: EmptyPrintObjectStyleAlign -> EmptyPrintObjectStyleAlign -> SystemDividers
mkSystemDividers :: EmptyPrintObjectStyleAlign
-> EmptyPrintObjectStyleAlign -> SystemDividers
mkSystemDividers EmptyPrintObjectStyleAlign
a EmptyPrintObjectStyleAlign
b = EmptyPrintObjectStyleAlign
-> EmptyPrintObjectStyleAlign -> SystemDividers
SystemDividers EmptyPrintObjectStyleAlign
a EmptyPrintObjectStyleAlign
b

-- | @system-layout@ /(complex)/
--
-- A system is a group of staves that are read and played simultaneously. System layout includes left and right margins and the vertical distance from the previous system. The system distance is measured from the bottom line of the previous system to the top line of the current system. It is ignored for the first system on a page. The top system distance is measured from the page's top margin to the top line of the first system. It is ignored for all but the first system on a page.
-- 
-- Sometimes the sum of measure widths in a system may not equal the system width specified by the layout elements due to roundoff or other errors. The behavior when reading MusicXML files in these cases is application-dependent. For instance, applications may find that the system layout data is more reliable than the sum of the measure widths, and adjust the measure widths accordingly.
data SystemLayout = 
      SystemLayout {
          SystemLayout -> Maybe SystemMargins
systemLayoutSystemMargins :: (Maybe SystemMargins) -- ^ /system-margins/ child element
        , SystemLayout -> Maybe Tenths
systemLayoutSystemDistance :: (Maybe Tenths) -- ^ /system-distance/ child element
        , SystemLayout -> Maybe Tenths
systemLayoutTopSystemDistance :: (Maybe Tenths) -- ^ /top-system-distance/ child element
        , SystemLayout -> Maybe SystemDividers
systemLayoutSystemDividers :: (Maybe SystemDividers) -- ^ /system-dividers/ child element
       }
    deriving (SystemLayout -> SystemLayout -> Bool
(SystemLayout -> SystemLayout -> Bool)
-> (SystemLayout -> SystemLayout -> Bool) -> Eq SystemLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemLayout -> SystemLayout -> Bool
$c/= :: SystemLayout -> SystemLayout -> Bool
== :: SystemLayout -> SystemLayout -> Bool
$c== :: SystemLayout -> SystemLayout -> Bool
Eq,Typeable,(forall x. SystemLayout -> Rep SystemLayout x)
-> (forall x. Rep SystemLayout x -> SystemLayout)
-> Generic SystemLayout
forall x. Rep SystemLayout x -> SystemLayout
forall x. SystemLayout -> Rep SystemLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SystemLayout x -> SystemLayout
$cfrom :: forall x. SystemLayout -> Rep SystemLayout x
Generic,Int -> SystemLayout -> ShowS
[SystemLayout] -> ShowS
SystemLayout -> String
(Int -> SystemLayout -> ShowS)
-> (SystemLayout -> String)
-> ([SystemLayout] -> ShowS)
-> Show SystemLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemLayout] -> ShowS
$cshowList :: [SystemLayout] -> ShowS
show :: SystemLayout -> String
$cshow :: SystemLayout -> String
showsPrec :: Int -> SystemLayout -> ShowS
$cshowsPrec :: Int -> SystemLayout -> ShowS
Show)
instance EmitXml SystemLayout where
    emitXml :: SystemLayout -> XmlRep
emitXml (SystemLayout Maybe SystemMargins
a Maybe Tenths
b Maybe Tenths
c Maybe SystemDividers
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep
-> (SystemMargins -> XmlRep) -> Maybe SystemMargins -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"system-margins" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SystemMargins -> XmlRep) -> SystemMargins -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SystemMargins -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SystemMargins
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"system-distance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"top-system-distance" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SystemDividers -> XmlRep) -> Maybe SystemDividers -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"system-dividers" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SystemDividers -> XmlRep) -> SystemDividers -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SystemDividers -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SystemDividers
d])
parseSystemLayout :: P.XParse SystemLayout
parseSystemLayout :: XParse SystemLayout
parseSystemLayout = 
      Maybe SystemMargins
-> Maybe Tenths
-> Maybe Tenths
-> Maybe SystemDividers
-> SystemLayout
SystemLayout
        (Maybe SystemMargins
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe SystemDividers
 -> SystemLayout)
-> XParse (Maybe SystemMargins)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths -> Maybe SystemDividers -> SystemLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SystemMargins -> XParse (Maybe SystemMargins)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse SystemMargins -> XParse SystemMargins
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"system-margins") (XParse SystemMargins
parseSystemMargins))
        XParse
  (Maybe Tenths
   -> Maybe Tenths -> Maybe SystemDividers -> SystemLayout)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe SystemDividers -> SystemLayout)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"system-distance") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))
        XParse (Maybe Tenths -> Maybe SystemDividers -> SystemLayout)
-> XParse (Maybe Tenths)
-> XParse (Maybe SystemDividers -> SystemLayout)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"top-system-distance") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))
        XParse (Maybe SystemDividers -> SystemLayout)
-> XParse (Maybe SystemDividers) -> XParse SystemLayout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SystemDividers -> XParse (Maybe SystemDividers)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse SystemDividers -> XParse SystemDividers
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"system-dividers") (XParse SystemDividers
parseSystemDividers))

-- | Smart constructor for 'SystemLayout'
mkSystemLayout :: SystemLayout
mkSystemLayout :: SystemLayout
mkSystemLayout = Maybe SystemMargins
-> Maybe Tenths
-> Maybe Tenths
-> Maybe SystemDividers
-> SystemLayout
SystemLayout Maybe SystemMargins
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe SystemDividers
forall a. Maybe a
Nothing

-- | @system-margins@ /(complex)/
--
-- System margins are relative to the page margins. Positive values indent and negative values reduce the margin size.
data SystemMargins = 
      SystemMargins {
          SystemMargins -> LeftRightMargins
systemMarginsLeftRightMargins :: LeftRightMargins
       }
    deriving (SystemMargins -> SystemMargins -> Bool
(SystemMargins -> SystemMargins -> Bool)
-> (SystemMargins -> SystemMargins -> Bool) -> Eq SystemMargins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemMargins -> SystemMargins -> Bool
$c/= :: SystemMargins -> SystemMargins -> Bool
== :: SystemMargins -> SystemMargins -> Bool
$c== :: SystemMargins -> SystemMargins -> Bool
Eq,Typeable,(forall x. SystemMargins -> Rep SystemMargins x)
-> (forall x. Rep SystemMargins x -> SystemMargins)
-> Generic SystemMargins
forall x. Rep SystemMargins x -> SystemMargins
forall x. SystemMargins -> Rep SystemMargins x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SystemMargins x -> SystemMargins
$cfrom :: forall x. SystemMargins -> Rep SystemMargins x
Generic,Int -> SystemMargins -> ShowS
[SystemMargins] -> ShowS
SystemMargins -> String
(Int -> SystemMargins -> ShowS)
-> (SystemMargins -> String)
-> ([SystemMargins] -> ShowS)
-> Show SystemMargins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemMargins] -> ShowS
$cshowList :: [SystemMargins] -> ShowS
show :: SystemMargins -> String
$cshow :: SystemMargins -> String
showsPrec :: Int -> SystemMargins -> ShowS
$cshowsPrec :: Int -> SystemMargins -> ShowS
Show)
instance EmitXml SystemMargins where
    emitXml :: SystemMargins -> XmlRep
emitXml (SystemMargins LeftRightMargins
a) =
      [XmlRep] -> XmlRep
XReps [LeftRightMargins -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml LeftRightMargins
a]
parseSystemMargins :: P.XParse SystemMargins
parseSystemMargins :: XParse SystemMargins
parseSystemMargins = 
      LeftRightMargins -> SystemMargins
SystemMargins
        (LeftRightMargins -> SystemMargins)
-> XParse LeftRightMargins -> XParse SystemMargins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse LeftRightMargins
parseLeftRightMargins

-- | Smart constructor for 'SystemMargins'
mkSystemMargins :: LeftRightMargins -> SystemMargins
mkSystemMargins :: LeftRightMargins -> SystemMargins
mkSystemMargins LeftRightMargins
a = LeftRightMargins -> SystemMargins
SystemMargins LeftRightMargins
a

-- | @tap@ /(complex)/
--
-- The tap type indicates a tap on the fretboard. The text content allows specification of the notation; + and T are common choices. If the element is empty, the hand attribute is used to specify the symbol to use. The hand attribute is ignored if the tap glyph is already specified by the text content. If neither text content nor the hand attribute are present, the display is application-specific.
data Tap = 
      Tap {
          Tap -> String
tapString :: String -- ^ text content
        , Tap -> Maybe TapHand
tapHand :: (Maybe TapHand) -- ^ /hand/ attribute
        , Tap -> Maybe Tenths
tapDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Tap -> Maybe Tenths
tapDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Tap -> Maybe Tenths
tapRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Tap -> Maybe Tenths
tapRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Tap -> Maybe CommaSeparatedText
tapFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Tap -> Maybe FontStyle
tapFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Tap -> Maybe FontSize
tapFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Tap -> Maybe FontWeight
tapFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Tap -> Maybe Color
tapColor :: (Maybe Color) -- ^ /color/ attribute
        , Tap -> Maybe AboveBelow
tapPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
       }
    deriving (Tap -> Tap -> Bool
(Tap -> Tap -> Bool) -> (Tap -> Tap -> Bool) -> Eq Tap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tap -> Tap -> Bool
$c/= :: Tap -> Tap -> Bool
== :: Tap -> Tap -> Bool
$c== :: Tap -> Tap -> Bool
Eq,Typeable,(forall x. Tap -> Rep Tap x)
-> (forall x. Rep Tap x -> Tap) -> Generic Tap
forall x. Rep Tap x -> Tap
forall x. Tap -> Rep Tap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tap x -> Tap
$cfrom :: forall x. Tap -> Rep Tap x
Generic,Int -> Tap -> ShowS
[Tap] -> ShowS
Tap -> String
(Int -> Tap -> ShowS)
-> (Tap -> String) -> ([Tap] -> ShowS) -> Show Tap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tap] -> ShowS
$cshowList :: [Tap] -> ShowS
show :: Tap -> String
$cshow :: Tap -> String
showsPrec :: Int -> Tap -> ShowS
$cshowsPrec :: Int -> Tap -> ShowS
Show)
instance EmitXml Tap where
    emitXml :: Tap -> XmlRep
emitXml (Tap String
a Maybe TapHand
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k Maybe AboveBelow
l) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (TapHand -> XmlRep) -> Maybe TapHand -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"hand" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TapHand -> XmlRep) -> TapHand -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TapHand -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TapHand
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
l])
        []
parseTap :: P.XParse Tap
parseTap :: XParse Tap
parseTap = 
      String
-> Maybe TapHand
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Tap
Tap
        (String
 -> Maybe TapHand
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Tap)
-> XParse String
-> XParse
     (Maybe TapHand
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe TapHand
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe TapHand)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TapHand -> XParse (Maybe TapHand)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"hand") XParse String -> (String -> XParse TapHand) -> XParse TapHand
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TapHand
parseTapHand)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Tap)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Tap)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> Maybe AboveBelow -> Tap)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> Maybe AboveBelow -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> Maybe AboveBelow -> Tap)
-> XParse (Maybe Color) -> XParse (Maybe AboveBelow -> Tap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Tap)
-> XParse (Maybe AboveBelow) -> XParse Tap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)

-- | Smart constructor for 'Tap'
mkTap :: String -> Tap
mkTap :: String -> Tap
mkTap String
a = String
-> Maybe TapHand
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Tap
Tap String
a Maybe TapHand
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing

-- | @technical@ /(complex)/
--
-- Technical indications give performance information for individual instruments.
data Technical = 
      Technical {
          Technical -> Maybe ID
technicalId :: (Maybe ID) -- ^ /id/ attribute
        , Technical -> [ChxTechnical]
technicalTechnical :: [ChxTechnical]
       }
    deriving (Technical -> Technical -> Bool
(Technical -> Technical -> Bool)
-> (Technical -> Technical -> Bool) -> Eq Technical
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Technical -> Technical -> Bool
$c/= :: Technical -> Technical -> Bool
== :: Technical -> Technical -> Bool
$c== :: Technical -> Technical -> Bool
Eq,Typeable,(forall x. Technical -> Rep Technical x)
-> (forall x. Rep Technical x -> Technical) -> Generic Technical
forall x. Rep Technical x -> Technical
forall x. Technical -> Rep Technical x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Technical x -> Technical
$cfrom :: forall x. Technical -> Rep Technical x
Generic,Int -> Technical -> ShowS
[Technical] -> ShowS
Technical -> String
(Int -> Technical -> ShowS)
-> (Technical -> String)
-> ([Technical] -> ShowS)
-> Show Technical
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Technical] -> ShowS
$cshowList :: [Technical] -> ShowS
show :: Technical -> String
$cshow :: Technical -> String
showsPrec :: Int -> Technical -> ShowS
$cshowsPrec :: Int -> Technical -> ShowS
Show)
instance EmitXml Technical where
    emitXml :: Technical -> XmlRep
emitXml (Technical Maybe ID
a [ChxTechnical]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
a])
        ([[ChxTechnical] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxTechnical]
b])
parseTechnical :: P.XParse Technical
parseTechnical :: XParse Technical
parseTechnical = 
      Maybe ID -> [ChxTechnical] -> Technical
Technical
        (Maybe ID -> [ChxTechnical] -> Technical)
-> XParse (Maybe ID) -> XParse ([ChxTechnical] -> Technical)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse ([ChxTechnical] -> Technical)
-> XParse [ChxTechnical] -> XParse Technical
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxTechnical -> XParse [ChxTechnical]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxTechnical
parseChxTechnical)

-- | Smart constructor for 'Technical'
mkTechnical :: Technical
mkTechnical :: Technical
mkTechnical = Maybe ID -> [ChxTechnical] -> Technical
Technical Maybe ID
forall a. Maybe a
Nothing []

-- | @text-element-data@ /(complex)/
--
-- The text-element-data type represents a syllable or portion of a syllable for lyric text underlay. A hyphen in the string content should only be used for an actual hyphenated word. Language names for text elements come from ISO 639, with optional country subcodes from ISO 3166.
data TextElementData = 
      TextElementData {
          TextElementData -> String
textElementDataString :: String -- ^ text content
        , TextElementData -> Maybe Lang
textElementDataLang :: (Maybe Lang) -- ^ /xml:lang/ attribute
        , TextElementData -> Maybe CommaSeparatedText
textElementDataFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , TextElementData -> Maybe FontStyle
textElementDataFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , TextElementData -> Maybe FontSize
textElementDataFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , TextElementData -> Maybe FontWeight
textElementDataFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , TextElementData -> Maybe Color
textElementDataColor :: (Maybe Color) -- ^ /color/ attribute
        , TextElementData -> Maybe NumberOfLines
textElementDataUnderline :: (Maybe NumberOfLines) -- ^ /underline/ attribute
        , TextElementData -> Maybe NumberOfLines
textElementDataOverline :: (Maybe NumberOfLines) -- ^ /overline/ attribute
        , TextElementData -> Maybe NumberOfLines
textElementDataLineThrough :: (Maybe NumberOfLines) -- ^ /line-through/ attribute
        , TextElementData -> Maybe RotationDegrees
textElementDataRotation :: (Maybe RotationDegrees) -- ^ /rotation/ attribute
        , TextElementData -> Maybe NumberOrNormal
textElementDataLetterSpacing :: (Maybe NumberOrNormal) -- ^ /letter-spacing/ attribute
        , TextElementData -> Maybe TextDirection
textElementDataDir :: (Maybe TextDirection) -- ^ /dir/ attribute
       }
    deriving (TextElementData -> TextElementData -> Bool
(TextElementData -> TextElementData -> Bool)
-> (TextElementData -> TextElementData -> Bool)
-> Eq TextElementData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextElementData -> TextElementData -> Bool
$c/= :: TextElementData -> TextElementData -> Bool
== :: TextElementData -> TextElementData -> Bool
$c== :: TextElementData -> TextElementData -> Bool
Eq,Typeable,(forall x. TextElementData -> Rep TextElementData x)
-> (forall x. Rep TextElementData x -> TextElementData)
-> Generic TextElementData
forall x. Rep TextElementData x -> TextElementData
forall x. TextElementData -> Rep TextElementData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextElementData x -> TextElementData
$cfrom :: forall x. TextElementData -> Rep TextElementData x
Generic,Int -> TextElementData -> ShowS
[TextElementData] -> ShowS
TextElementData -> String
(Int -> TextElementData -> ShowS)
-> (TextElementData -> String)
-> ([TextElementData] -> ShowS)
-> Show TextElementData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextElementData] -> ShowS
$cshowList :: [TextElementData] -> ShowS
show :: TextElementData -> String
$cshow :: TextElementData -> String
showsPrec :: Int -> TextElementData -> ShowS
$cshowsPrec :: Int -> TextElementData -> ShowS
Show)
instance EmitXml TextElementData where
    emitXml :: TextElementData -> XmlRep
emitXml (TextElementData String
a Maybe Lang
b Maybe CommaSeparatedText
c Maybe FontStyle
d Maybe FontSize
e Maybe FontWeight
f Maybe Color
g Maybe NumberOfLines
h Maybe NumberOfLines
i Maybe NumberOfLines
j Maybe RotationDegrees
k Maybe NumberOrNormal
l Maybe TextDirection
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Lang -> XmlRep) -> Maybe Lang -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"lang" (String -> Maybe String
forall a. a -> Maybe a
Just String
"xml"))(XmlRep -> XmlRep) -> (Lang -> XmlRep) -> Lang -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lang -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Lang
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"underline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"overline" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOfLines -> XmlRep) -> Maybe NumberOfLines -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-through" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOfLines -> XmlRep) -> NumberOfLines -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOfLines -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOfLines
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (RotationDegrees -> XmlRep) -> Maybe RotationDegrees -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"rotation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (RotationDegrees -> XmlRep) -> RotationDegrees -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.RotationDegrees -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe RotationDegrees
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (NumberOrNormal -> XmlRep) -> Maybe NumberOrNormal -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"letter-spacing" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberOrNormal -> XmlRep) -> NumberOrNormal -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberOrNormal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberOrNormal
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TextDirection -> XmlRep) -> Maybe TextDirection -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dir" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TextDirection -> XmlRep) -> TextDirection -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TextDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TextDirection
m])
        []
parseTextElementData :: P.XParse TextElementData
parseTextElementData :: XParse TextElementData
parseTextElementData = 
      String
-> Maybe Lang
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> TextElementData
TextElementData
        (String
 -> Maybe Lang
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe NumberOfLines
 -> Maybe RotationDegrees
 -> Maybe NumberOrNormal
 -> Maybe TextDirection
 -> TextElementData)
-> XParse String
-> XParse
     (Maybe Lang
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse
  (Maybe Lang
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe Lang)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Lang -> XParse (Maybe Lang)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"xml:lang") XParse String -> (String -> XParse Lang) -> XParse Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Lang
parseLang)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe Color)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"underline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe NumberOfLines
      -> Maybe RotationDegrees
      -> Maybe NumberOrNormal
      -> Maybe TextDirection
      -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"overline") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe NumberOfLines
   -> Maybe RotationDegrees
   -> Maybe NumberOrNormal
   -> Maybe TextDirection
   -> TextElementData)
-> XParse (Maybe NumberOfLines)
-> XParse
     (Maybe RotationDegrees
      -> Maybe NumberOrNormal -> Maybe TextDirection -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOfLines -> XParse (Maybe NumberOfLines)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-through") XParse String
-> (String -> XParse NumberOfLines) -> XParse NumberOfLines
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOfLines
parseNumberOfLines)
        XParse
  (Maybe RotationDegrees
   -> Maybe NumberOrNormal -> Maybe TextDirection -> TextElementData)
-> XParse (Maybe RotationDegrees)
-> XParse
     (Maybe NumberOrNormal -> Maybe TextDirection -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse RotationDegrees -> XParse (Maybe RotationDegrees)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"rotation") XParse String
-> (String -> XParse RotationDegrees) -> XParse RotationDegrees
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse RotationDegrees
parseRotationDegrees)
        XParse
  (Maybe NumberOrNormal -> Maybe TextDirection -> TextElementData)
-> XParse (Maybe NumberOrNormal)
-> XParse (Maybe TextDirection -> TextElementData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberOrNormal -> XParse (Maybe NumberOrNormal)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"letter-spacing") XParse String
-> (String -> XParse NumberOrNormal) -> XParse NumberOrNormal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberOrNormal
parseNumberOrNormal)
        XParse (Maybe TextDirection -> TextElementData)
-> XParse (Maybe TextDirection) -> XParse TextElementData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TextDirection -> XParse (Maybe TextDirection)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dir") XParse String
-> (String -> XParse TextDirection) -> XParse TextDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TextDirection
parseTextDirection)

-- | Smart constructor for 'TextElementData'
mkTextElementData :: String -> TextElementData
mkTextElementData :: String -> TextElementData
mkTextElementData String
a = String
-> Maybe Lang
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe NumberOfLines
-> Maybe RotationDegrees
-> Maybe NumberOrNormal
-> Maybe TextDirection
-> TextElementData
TextElementData String
a Maybe Lang
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe NumberOfLines
forall a. Maybe a
Nothing Maybe RotationDegrees
forall a. Maybe a
Nothing Maybe NumberOrNormal
forall a. Maybe a
Nothing Maybe TextDirection
forall a. Maybe a
Nothing

-- | @tie@ /(complex)/
--
-- The tie element indicates that a tie begins or ends with this note. If the tie element applies only particular times through a repeat, the time-only attribute indicates which times to apply it. The tie element indicates sound; the tied element indicates notation.
data Tie = 
      Tie {
          Tie -> StartStop
tieType :: StartStop -- ^ /type/ attribute
        , Tie -> Maybe TimeOnly
tieTimeOnly :: (Maybe TimeOnly) -- ^ /time-only/ attribute
       }
    deriving (Tie -> Tie -> Bool
(Tie -> Tie -> Bool) -> (Tie -> Tie -> Bool) -> Eq Tie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tie -> Tie -> Bool
$c/= :: Tie -> Tie -> Bool
== :: Tie -> Tie -> Bool
$c== :: Tie -> Tie -> Bool
Eq,Typeable,(forall x. Tie -> Rep Tie x)
-> (forall x. Rep Tie x -> Tie) -> Generic Tie
forall x. Rep Tie x -> Tie
forall x. Tie -> Rep Tie x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tie x -> Tie
$cfrom :: forall x. Tie -> Rep Tie x
Generic,Int -> Tie -> ShowS
[Tie] -> ShowS
Tie -> String
(Int -> Tie -> ShowS)
-> (Tie -> String) -> ([Tie] -> ShowS) -> Show Tie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tie] -> ShowS
$cshowList :: [Tie] -> ShowS
show :: Tie -> String
$cshow :: Tie -> String
showsPrec :: Int -> Tie -> ShowS
$cshowsPrec :: Int -> Tie -> ShowS
Show)
instance EmitXml Tie where
    emitXml :: Tie -> XmlRep
emitXml (Tie StartStop
a Maybe TimeOnly
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TimeOnly -> XmlRep) -> Maybe TimeOnly -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"time-only" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TimeOnly -> XmlRep) -> TimeOnly -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeOnly -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeOnly
b])
        []
parseTie :: P.XParse Tie
parseTie :: XParse Tie
parseTie = 
      StartStop -> Maybe TimeOnly -> Tie
Tie
        (StartStop -> Maybe TimeOnly -> Tie)
-> XParse StartStop -> XParse (Maybe TimeOnly -> Tie)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse (Maybe TimeOnly -> Tie)
-> XParse (Maybe TimeOnly) -> XParse Tie
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeOnly -> XParse (Maybe TimeOnly)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"time-only") XParse String -> (String -> XParse TimeOnly) -> XParse TimeOnly
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeOnly
parseTimeOnly)

-- | Smart constructor for 'Tie'
mkTie :: StartStop -> Tie
mkTie :: StartStop -> Tie
mkTie StartStop
a = StartStop -> Maybe TimeOnly -> Tie
Tie StartStop
a Maybe TimeOnly
forall a. Maybe a
Nothing

-- | @tied@ /(complex)/
--
-- The tied element represents the notated tie. The tie element represents the tie sound.
-- 
-- The number attribute is rarely needed to disambiguate ties, since note pitches will usually suffice. The attribute is implied rather than defaulting to 1 as with most elements. It is available for use in more complex tied notation situations.
-- 
-- Ties that join two notes of the same pitch together should be represented with a tied element on the first note with type="start" and a tied element on the second note with type="stop".  This can also be done if the two notes being tied are enharmonically equivalent, but have different step values. It is not recommended to use tied elements to join two notes with enharmonically inequivalent pitches.
-- 
-- Ties that indicate that an instrument should be undamped are specified with a single tied element with type="let-ring".
-- 
-- Ties that are visually attached to only one note, other than undamped ties, should be specified with two tied elements on the same note, first type="start" then type="stop". This can be used to represent ties into or out of repeated sections or codas.
data Tied = 
      Tied {
          Tied -> TiedType
tiedType :: TiedType -- ^ /type/ attribute
        , Tied -> Maybe NumberLevel
tiedNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Tied -> Maybe LineType
tiedLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Tied -> Maybe Tenths
tiedDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Tied -> Maybe Tenths
tiedSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Tied -> Maybe Tenths
tiedDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Tied -> Maybe Tenths
tiedDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Tied -> Maybe Tenths
tiedRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Tied -> Maybe Tenths
tiedRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Tied -> Maybe AboveBelow
tiedPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Tied -> Maybe OverUnder
tiedOrientation :: (Maybe OverUnder) -- ^ /orientation/ attribute
        , Tied -> Maybe Tenths
tiedBezierX :: (Maybe Tenths) -- ^ /bezier-x/ attribute
        , Tied -> Maybe Tenths
tiedBezierY :: (Maybe Tenths) -- ^ /bezier-y/ attribute
        , Tied -> Maybe Tenths
tiedBezierX2 :: (Maybe Tenths) -- ^ /bezier-x2/ attribute
        , Tied -> Maybe Tenths
tiedBezierY2 :: (Maybe Tenths) -- ^ /bezier-y2/ attribute
        , Tied -> Maybe Divisions
tiedBezierOffset :: (Maybe Divisions) -- ^ /bezier-offset/ attribute
        , Tied -> Maybe Divisions
tiedBezierOffset2 :: (Maybe Divisions) -- ^ /bezier-offset2/ attribute
        , Tied -> Maybe Color
tiedColor :: (Maybe Color) -- ^ /color/ attribute
        , Tied -> Maybe ID
tiedId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Tied -> Tied -> Bool
(Tied -> Tied -> Bool) -> (Tied -> Tied -> Bool) -> Eq Tied
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tied -> Tied -> Bool
$c/= :: Tied -> Tied -> Bool
== :: Tied -> Tied -> Bool
$c== :: Tied -> Tied -> Bool
Eq,Typeable,(forall x. Tied -> Rep Tied x)
-> (forall x. Rep Tied x -> Tied) -> Generic Tied
forall x. Rep Tied x -> Tied
forall x. Tied -> Rep Tied x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tied x -> Tied
$cfrom :: forall x. Tied -> Rep Tied x
Generic,Int -> Tied -> ShowS
[Tied] -> ShowS
Tied -> String
(Int -> Tied -> ShowS)
-> (Tied -> String) -> ([Tied] -> ShowS) -> Show Tied
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tied] -> ShowS
$cshowList :: [Tied] -> ShowS
show :: Tied -> String
$cshow :: Tied -> String
showsPrec :: Int -> Tied -> ShowS
$cshowsPrec :: Int -> Tied -> ShowS
Show)
instance EmitXml Tied where
    emitXml :: Tied -> XmlRep
emitXml (Tied TiedType
a Maybe NumberLevel
b Maybe LineType
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe AboveBelow
j Maybe OverUnder
k Maybe Tenths
l Maybe Tenths
m Maybe Tenths
n Maybe Tenths
o Maybe Divisions
p Maybe Divisions
q Maybe Color
r Maybe ID
s) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (TiedType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TiedType
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (OverUnder -> XmlRep) -> Maybe OverUnder -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"orientation" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (OverUnder -> XmlRep) -> OverUnder -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.OverUnder -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe OverUnder
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-x2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-y2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-offset" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
p] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Divisions -> XmlRep) -> Maybe Divisions -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bezier-offset2" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Divisions -> XmlRep) -> Divisions -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Divisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Divisions
q] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
r] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
s])
        []
parseTied :: P.XParse Tied
parseTied :: XParse Tied
parseTied = 
      TiedType
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe OverUnder
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Divisions
-> Maybe Divisions
-> Maybe Color
-> Maybe ID
-> Tied
Tied
        (TiedType
 -> Maybe NumberLevel
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe OverUnder
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Divisions
 -> Maybe Divisions
 -> Maybe Color
 -> Maybe ID
 -> Tied)
-> XParse TiedType
-> XParse
     (Maybe NumberLevel
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse TiedType) -> XParse TiedType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TiedType
parseTiedType)
        XParse
  (Maybe NumberLevel
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow
      -> Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow
   -> Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe OverUnder
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe OverUnder
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe OverUnder)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse OverUnder -> XParse (Maybe OverUnder)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"orientation") XParse String -> (String -> XParse OverUnder) -> XParse OverUnder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse OverUnder
parseOverUnder)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Divisions
      -> Maybe Divisions
      -> Maybe Color
      -> Maybe ID
      -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-x2") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Divisions
   -> Maybe Divisions
   -> Maybe Color
   -> Maybe ID
   -> Tied)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Divisions
      -> Maybe Divisions -> Maybe Color -> Maybe ID -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-y2") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Divisions
   -> Maybe Divisions -> Maybe Color -> Maybe ID -> Tied)
-> XParse (Maybe Divisions)
-> XParse (Maybe Divisions -> Maybe Color -> Maybe ID -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-offset") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe Divisions -> Maybe Color -> Maybe ID -> Tied)
-> XParse (Maybe Divisions)
-> XParse (Maybe Color -> Maybe ID -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Divisions -> XParse (Maybe Divisions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bezier-offset2") XParse String -> (String -> XParse Divisions) -> XParse Divisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Divisions
parseDivisions)
        XParse (Maybe Color -> Maybe ID -> Tied)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Tied)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Tied) -> XParse (Maybe ID) -> XParse Tied
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Tied'
mkTied :: TiedType -> Tied
mkTied :: TiedType -> Tied
mkTied TiedType
a = TiedType
-> Maybe NumberLevel
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe OverUnder
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Divisions
-> Maybe Divisions
-> Maybe Color
-> Maybe ID
-> Tied
Tied TiedType
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe OverUnder
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe Divisions
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @time@ /(complex)/
--
-- Time signatures are represented by the beats element for the numerator and the beat-type element for the denominator. The symbol attribute is used indicate common and cut time symbols as well as a single number display. Multiple pairs of beat and beat-type elements are used for composite time signatures with multiple denominators, such as 2/4 + 3/8. A composite such as 3+2/8 requires only one beat/beat-type pair.
-- 
-- The print-object attribute allows a time signature to be specified but not printed, as is the case for excerpts from the middle of a score. The value is "yes" if not present. The optional number attribute refers to staff numbers within the part. If absent, the time signature applies to all staves in the part.
data Time = 
      Time {
          Time -> Maybe StaffNumber
timeNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , Time -> Maybe TimeSymbol
timeSymbol :: (Maybe TimeSymbol) -- ^ /symbol/ attribute
        , Time -> Maybe TimeSeparator
timeSeparator :: (Maybe TimeSeparator) -- ^ /separator/ attribute
        , Time -> Maybe Tenths
timeDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Time -> Maybe Tenths
timeDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Time -> Maybe Tenths
timeRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Time -> Maybe Tenths
timeRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Time -> Maybe CommaSeparatedText
timeFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Time -> Maybe FontStyle
timeFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Time -> Maybe FontSize
timeFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Time -> Maybe FontWeight
timeFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Time -> Maybe Color
timeColor :: (Maybe Color) -- ^ /color/ attribute
        , Time -> Maybe LeftCenterRight
timeHalign :: (Maybe LeftCenterRight) -- ^ /halign/ attribute
        , Time -> Maybe Valign
timeValign :: (Maybe Valign) -- ^ /valign/ attribute
        , Time -> Maybe YesNo
timePrintObject :: (Maybe YesNo) -- ^ /print-object/ attribute
        , Time -> Maybe ID
timeId :: (Maybe ID) -- ^ /id/ attribute
        , Time -> ChxTime
timeTime :: ChxTime
       }
    deriving (Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq,Typeable,(forall x. Time -> Rep Time x)
-> (forall x. Rep Time x -> Time) -> Generic Time
forall x. Rep Time x -> Time
forall x. Time -> Rep Time x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Time x -> Time
$cfrom :: forall x. Time -> Rep Time x
Generic,Int -> Time -> ShowS
[Time] -> ShowS
Time -> String
(Int -> Time -> ShowS)
-> (Time -> String) -> ([Time] -> ShowS) -> Show Time
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Time] -> ShowS
$cshowList :: [Time] -> ShowS
show :: Time -> String
$cshow :: Time -> String
showsPrec :: Int -> Time -> ShowS
$cshowsPrec :: Int -> Time -> ShowS
Show)
instance EmitXml Time where
    emitXml :: Time -> XmlRep
emitXml (Time Maybe StaffNumber
a Maybe TimeSymbol
b Maybe TimeSeparator
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe Tenths
g Maybe CommaSeparatedText
h Maybe FontStyle
i Maybe FontSize
j Maybe FontWeight
k Maybe Color
l Maybe LeftCenterRight
m Maybe Valign
n Maybe YesNo
o Maybe ID
p ChxTime
q) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TimeSymbol -> XmlRep) -> Maybe TimeSymbol -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"symbol" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeSymbol -> XmlRep) -> TimeSymbol -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeSymbol -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeSymbol
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TimeSeparator -> XmlRep) -> Maybe TimeSeparator -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"separator" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TimeSeparator -> XmlRep) -> TimeSeparator -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TimeSeparator -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TimeSeparator
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (LeftCenterRight -> XmlRep) -> Maybe LeftCenterRight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"halign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (LeftCenterRight -> XmlRep) -> LeftCenterRight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LeftCenterRight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LeftCenterRight
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Valign -> XmlRep) -> Maybe Valign -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"valign" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Valign -> XmlRep) -> Valign -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Valign -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Valign
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"print-object" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
o] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
p])
        ([ChxTime -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxTime
q])
parseTime :: P.XParse Time
parseTime :: XParse Time
parseTime = 
      Maybe StaffNumber
-> Maybe TimeSymbol
-> Maybe TimeSeparator
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe YesNo
-> Maybe ID
-> ChxTime
-> Time
Time
        (Maybe StaffNumber
 -> Maybe TimeSymbol
 -> Maybe TimeSeparator
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe LeftCenterRight
 -> Maybe Valign
 -> Maybe YesNo
 -> Maybe ID
 -> ChxTime
 -> Time)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe TimeSymbol
      -> Maybe TimeSeparator
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe TimeSymbol
   -> Maybe TimeSeparator
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe TimeSymbol)
-> XParse
     (Maybe TimeSeparator
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeSymbol -> XParse (Maybe TimeSymbol)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"symbol") XParse String -> (String -> XParse TimeSymbol) -> XParse TimeSymbol
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeSymbol
parseTimeSymbol)
        XParse
  (Maybe TimeSeparator
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe TimeSeparator)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TimeSeparator -> XParse (Maybe TimeSeparator)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"separator") XParse String
-> (String -> XParse TimeSeparator) -> XParse TimeSeparator
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TimeSeparator
parseTimeSeparator)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe LeftCenterRight
      -> Maybe Valign
      -> Maybe YesNo
      -> Maybe ID
      -> ChxTime
      -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe LeftCenterRight
   -> Maybe Valign
   -> Maybe YesNo
   -> Maybe ID
   -> ChxTime
   -> Time)
-> XParse (Maybe Color)
-> XParse
     (Maybe LeftCenterRight
      -> Maybe Valign -> Maybe YesNo -> Maybe ID -> ChxTime -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe LeftCenterRight
   -> Maybe Valign -> Maybe YesNo -> Maybe ID -> ChxTime -> Time)
-> XParse (Maybe LeftCenterRight)
-> XParse
     (Maybe Valign -> Maybe YesNo -> Maybe ID -> ChxTime -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LeftCenterRight -> XParse (Maybe LeftCenterRight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"halign") XParse String
-> (String -> XParse LeftCenterRight) -> XParse LeftCenterRight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LeftCenterRight
parseLeftCenterRight)
        XParse (Maybe Valign -> Maybe YesNo -> Maybe ID -> ChxTime -> Time)
-> XParse (Maybe Valign)
-> XParse (Maybe YesNo -> Maybe ID -> ChxTime -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Valign -> XParse (Maybe Valign)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"valign") XParse String -> (String -> XParse Valign) -> XParse Valign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Valign
parseValign)
        XParse (Maybe YesNo -> Maybe ID -> ChxTime -> Time)
-> XParse (Maybe YesNo) -> XParse (Maybe ID -> ChxTime -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"print-object") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse (Maybe ID -> ChxTime -> Time)
-> XParse (Maybe ID) -> XParse (ChxTime -> Time)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (ChxTime -> Time) -> XParse ChxTime -> XParse Time
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxTime
parseChxTime

-- | Smart constructor for 'Time'
mkTime :: ChxTime -> Time
mkTime :: ChxTime -> Time
mkTime ChxTime
q = Maybe StaffNumber
-> Maybe TimeSymbol
-> Maybe TimeSeparator
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe LeftCenterRight
-> Maybe Valign
-> Maybe YesNo
-> Maybe ID
-> ChxTime
-> Time
Time Maybe StaffNumber
forall a. Maybe a
Nothing Maybe TimeSymbol
forall a. Maybe a
Nothing Maybe TimeSeparator
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe LeftCenterRight
forall a. Maybe a
Nothing Maybe Valign
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing ChxTime
q

-- | @time-modification@ /(complex)/
--
-- Time modification indicates tuplets, double-note tremolos, and other durational changes. A time-modification element shows how the cumulative, sounding effect of tuplets and double-note tremolos compare to the written note type represented by the type and dot elements. Nested tuplets and other notations that use more detailed information need both the time-modification and tuplet elements to be represented accurately.
data TimeModification = 
      TimeModification {
          TimeModification -> NonNegativeInteger
timeModificationActualNotes :: NonNegativeInteger -- ^ /actual-notes/ child element
        , TimeModification -> NonNegativeInteger
timeModificationNormalNotes :: NonNegativeInteger -- ^ /normal-notes/ child element
        , TimeModification -> Maybe SeqTimeModification
timeModificationTimeModification :: (Maybe SeqTimeModification)
       }
    deriving (TimeModification -> TimeModification -> Bool
(TimeModification -> TimeModification -> Bool)
-> (TimeModification -> TimeModification -> Bool)
-> Eq TimeModification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeModification -> TimeModification -> Bool
$c/= :: TimeModification -> TimeModification -> Bool
== :: TimeModification -> TimeModification -> Bool
$c== :: TimeModification -> TimeModification -> Bool
Eq,Typeable,(forall x. TimeModification -> Rep TimeModification x)
-> (forall x. Rep TimeModification x -> TimeModification)
-> Generic TimeModification
forall x. Rep TimeModification x -> TimeModification
forall x. TimeModification -> Rep TimeModification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeModification x -> TimeModification
$cfrom :: forall x. TimeModification -> Rep TimeModification x
Generic,Int -> TimeModification -> ShowS
[TimeModification] -> ShowS
TimeModification -> String
(Int -> TimeModification -> ShowS)
-> (TimeModification -> String)
-> ([TimeModification] -> ShowS)
-> Show TimeModification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeModification] -> ShowS
$cshowList :: [TimeModification] -> ShowS
show :: TimeModification -> String
$cshow :: TimeModification -> String
showsPrec :: Int -> TimeModification -> ShowS
$cshowsPrec :: Int -> TimeModification -> ShowS
Show)
instance EmitXml TimeModification where
    emitXml :: TimeModification -> XmlRep
emitXml (TimeModification NonNegativeInteger
a NonNegativeInteger
b Maybe SeqTimeModification
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"actual-notes" Maybe String
forall a. Maybe a
Nothing) (NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeInteger
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"normal-notes" Maybe String
forall a. Maybe a
Nothing) (NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeInteger
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe SeqTimeModification -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe SeqTimeModification
c])
parseTimeModification :: P.XParse TimeModification
parseTimeModification :: XParse TimeModification
parseTimeModification = 
      NonNegativeInteger
-> NonNegativeInteger
-> Maybe SeqTimeModification
-> TimeModification
TimeModification
        (NonNegativeInteger
 -> NonNegativeInteger
 -> Maybe SeqTimeModification
 -> TimeModification)
-> XParse NonNegativeInteger
-> XParse
     (NonNegativeInteger
      -> Maybe SeqTimeModification -> TimeModification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"actual-notes") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse
  (NonNegativeInteger
   -> Maybe SeqTimeModification -> TimeModification)
-> XParse NonNegativeInteger
-> XParse (Maybe SeqTimeModification -> TimeModification)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse NonNegativeInteger -> XParse NonNegativeInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"normal-notes") (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger))
        XParse (Maybe SeqTimeModification -> TimeModification)
-> XParse (Maybe SeqTimeModification) -> XParse TimeModification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqTimeModification -> XParse (Maybe SeqTimeModification)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse SeqTimeModification
parseSeqTimeModification)

-- | Smart constructor for 'TimeModification'
mkTimeModification :: NonNegativeInteger -> NonNegativeInteger -> TimeModification
mkTimeModification :: NonNegativeInteger -> NonNegativeInteger -> TimeModification
mkTimeModification NonNegativeInteger
a NonNegativeInteger
b = NonNegativeInteger
-> NonNegativeInteger
-> Maybe SeqTimeModification
-> TimeModification
TimeModification NonNegativeInteger
a NonNegativeInteger
b Maybe SeqTimeModification
forall a. Maybe a
Nothing

-- | @transpose@ /(complex)/
--
-- The transpose type represents what must be added to a written pitch to get a correct sounding pitch. The optional number attribute refers to staff numbers, from top to bottom on the system. If absent, the transposition applies to all staves in the part. Per-staff transposition is most often used in parts that represent multiple instruments.
data Transpose = 
      Transpose {
          Transpose -> Maybe StaffNumber
transposeNumber :: (Maybe StaffNumber) -- ^ /number/ attribute
        , Transpose -> Maybe ID
transposeId :: (Maybe ID) -- ^ /id/ attribute
        , Transpose -> Maybe Int
transposeDiatonic :: (Maybe Int) -- ^ /diatonic/ child element
        , Transpose -> Semitones
transposeChromatic :: Semitones -- ^ /chromatic/ child element
        , Transpose -> Maybe Int
transposeOctaveChange :: (Maybe Int) -- ^ /octave-change/ child element
        , Transpose -> Maybe Empty
transposeDouble :: (Maybe Empty) -- ^ /double/ child element
       }
    deriving (Transpose -> Transpose -> Bool
(Transpose -> Transpose -> Bool)
-> (Transpose -> Transpose -> Bool) -> Eq Transpose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transpose -> Transpose -> Bool
$c/= :: Transpose -> Transpose -> Bool
== :: Transpose -> Transpose -> Bool
$c== :: Transpose -> Transpose -> Bool
Eq,Typeable,(forall x. Transpose -> Rep Transpose x)
-> (forall x. Rep Transpose x -> Transpose) -> Generic Transpose
forall x. Rep Transpose x -> Transpose
forall x. Transpose -> Rep Transpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Transpose x -> Transpose
$cfrom :: forall x. Transpose -> Rep Transpose x
Generic,Int -> Transpose -> ShowS
[Transpose] -> ShowS
Transpose -> String
(Int -> Transpose -> ShowS)
-> (Transpose -> String)
-> ([Transpose] -> ShowS)
-> Show Transpose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transpose] -> ShowS
$cshowList :: [Transpose] -> ShowS
show :: Transpose -> String
$cshow :: Transpose -> String
showsPrec :: Int -> Transpose -> ShowS
$cshowsPrec :: Int -> Transpose -> ShowS
Show)
instance EmitXml Transpose where
    emitXml :: Transpose -> XmlRep
emitXml (Transpose Maybe StaffNumber
a Maybe ID
b Maybe Int
c Semitones
d Maybe Int
e Maybe Empty
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep -> (StaffNumber -> XmlRep) -> Maybe StaffNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffNumber -> XmlRep) -> StaffNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StaffNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
b])
        ([XmlRep -> (Int -> XmlRep) -> Maybe Int -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"diatonic" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Int -> XmlRep) -> Int -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Int
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"chromatic" Maybe String
forall a. Maybe a
Nothing) (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
d)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Int -> XmlRep) -> Maybe Int -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"octave-change" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Int -> XmlRep) -> Int -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Int
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"double" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
f])
parseTranspose :: P.XParse Transpose
parseTranspose :: XParse Transpose
parseTranspose = 
      Maybe StaffNumber
-> Maybe ID
-> Maybe Int
-> Semitones
-> Maybe Int
-> Maybe Empty
-> Transpose
Transpose
        (Maybe StaffNumber
 -> Maybe ID
 -> Maybe Int
 -> Semitones
 -> Maybe Int
 -> Maybe Empty
 -> Transpose)
-> XParse (Maybe StaffNumber)
-> XParse
     (Maybe ID
      -> Maybe Int -> Semitones -> Maybe Int -> Maybe Empty -> Transpose)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse StaffNumber -> XParse (Maybe StaffNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse StaffNumber) -> XParse StaffNumber
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StaffNumber
parseStaffNumber)
        XParse
  (Maybe ID
   -> Maybe Int -> Semitones -> Maybe Int -> Maybe Empty -> Transpose)
-> XParse (Maybe ID)
-> XParse
     (Maybe Int -> Semitones -> Maybe Int -> Maybe Empty -> Transpose)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse
  (Maybe Int -> Semitones -> Maybe Int -> Maybe Empty -> Transpose)
-> XParse (Maybe Int)
-> XParse (Semitones -> Maybe Int -> Maybe Empty -> Transpose)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Int -> XParse (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Int -> XParse Int
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"diatonic") (XParse String
P.xtext XParse String -> (String -> XParse Int) -> XParse Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> String -> XParse Int
forall a. Read a => String -> String -> XParse a
P.xread String
"Integer")))
        XParse (Semitones -> Maybe Int -> Maybe Empty -> Transpose)
-> XParse Semitones
-> XParse (Maybe Int -> Maybe Empty -> Transpose)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"chromatic") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))
        XParse (Maybe Int -> Maybe Empty -> Transpose)
-> XParse (Maybe Int) -> XParse (Maybe Empty -> Transpose)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Int -> XParse (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Int -> XParse Int
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"octave-change") (XParse String
P.xtext XParse String -> (String -> XParse Int) -> XParse Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> String -> XParse Int
forall a. Read a => String -> String -> XParse a
P.xread String
"Integer")))
        XParse (Maybe Empty -> Transpose)
-> XParse (Maybe Empty) -> XParse Transpose
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"double") (XParse Empty
parseEmpty))

-- | Smart constructor for 'Transpose'
mkTranspose :: Semitones -> Transpose
mkTranspose :: Semitones -> Transpose
mkTranspose Semitones
d = Maybe StaffNumber
-> Maybe ID
-> Maybe Int
-> Semitones
-> Maybe Int
-> Maybe Empty
-> Transpose
Transpose Maybe StaffNumber
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Semitones
d Maybe Int
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing

-- | @tremolo@ /(complex)/
--
-- The tremolo ornament can be used to indicate single-note, double-note, or unmeasured tremolos. Single-note tremolos use the single type, double-note tremolos use the start and stop types, and unmeasured tremolos use the unmeasured type. The default is "single" for compatibility with Version 1.1. The text of the element indicates the number of tremolo marks and is an integer from 0 to 8. Note that the number of attached beams is not included in this value, but is represented separately using the beam element. The value should be 0 for unmeasured tremolos.
-- 
-- 	When using double-note tremolos, the duration of each note in the tremolo should correspond to half of the notated type value. A time-modification element should also be added with an actual-notes value of 2 and a normal-notes value of 1. If used within a tuplet, this 2/1 ratio should be multiplied by the existing tuplet ratio.
-- 
-- 	The smufl attribute specifies the glyph to use from the SMuFL tremolos range for an unmeasured tremolo. It is ignored for other tremolo types. The SMuFL buzzRoll glyph is used by default if the attribute is missing.
-- 
-- 	Using repeater beams for indicating tremolos is deprecated as of MusicXML 3.0.
data Tremolo = 
      Tremolo {
          Tremolo -> TremoloMarks
tremoloTremoloMarks :: TremoloMarks -- ^ text content
        , Tremolo -> Maybe TremoloType
tremoloType :: (Maybe TremoloType) -- ^ /type/ attribute
        , Tremolo -> Maybe Tenths
tremoloDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Tremolo -> Maybe Tenths
tremoloDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Tremolo -> Maybe Tenths
tremoloRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Tremolo -> Maybe Tenths
tremoloRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Tremolo -> Maybe CommaSeparatedText
tremoloFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , Tremolo -> Maybe FontStyle
tremoloFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , Tremolo -> Maybe FontSize
tremoloFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , Tremolo -> Maybe FontWeight
tremoloFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , Tremolo -> Maybe Color
tremoloColor :: (Maybe Color) -- ^ /color/ attribute
        , Tremolo -> Maybe AboveBelow
tremoloPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Tremolo -> Maybe SmuflGlyphName
tremoloSmufl :: (Maybe SmuflGlyphName) -- ^ /smufl/ attribute
       }
    deriving (Tremolo -> Tremolo -> Bool
(Tremolo -> Tremolo -> Bool)
-> (Tremolo -> Tremolo -> Bool) -> Eq Tremolo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tremolo -> Tremolo -> Bool
$c/= :: Tremolo -> Tremolo -> Bool
== :: Tremolo -> Tremolo -> Bool
$c== :: Tremolo -> Tremolo -> Bool
Eq,Typeable,(forall x. Tremolo -> Rep Tremolo x)
-> (forall x. Rep Tremolo x -> Tremolo) -> Generic Tremolo
forall x. Rep Tremolo x -> Tremolo
forall x. Tremolo -> Rep Tremolo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tremolo x -> Tremolo
$cfrom :: forall x. Tremolo -> Rep Tremolo x
Generic,Int -> Tremolo -> ShowS
[Tremolo] -> ShowS
Tremolo -> String
(Int -> Tremolo -> ShowS)
-> (Tremolo -> String) -> ([Tremolo] -> ShowS) -> Show Tremolo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tremolo] -> ShowS
$cshowList :: [Tremolo] -> ShowS
show :: Tremolo -> String
$cshow :: Tremolo -> String
showsPrec :: Int -> Tremolo -> ShowS
$cshowsPrec :: Int -> Tremolo -> ShowS
Show)
instance EmitXml Tremolo where
    emitXml :: Tremolo -> XmlRep
emitXml (Tremolo TremoloMarks
a Maybe TremoloType
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe CommaSeparatedText
g Maybe FontStyle
h Maybe FontSize
i Maybe FontWeight
j Maybe Color
k Maybe AboveBelow
l Maybe SmuflGlyphName
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (TremoloMarks -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TremoloMarks
a)
        ([XmlRep -> (TremoloType -> XmlRep) -> Maybe TremoloType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TremoloType -> XmlRep) -> TremoloType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TremoloType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TremoloType
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (SmuflGlyphName -> XmlRep) -> Maybe SmuflGlyphName -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"smufl" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SmuflGlyphName -> XmlRep) -> SmuflGlyphName -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SmuflGlyphName -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SmuflGlyphName
m])
        []
parseTremolo :: P.XParse Tremolo
parseTremolo :: XParse Tremolo
parseTremolo = 
      TremoloMarks
-> Maybe TremoloType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> Tremolo
Tremolo
        (TremoloMarks
 -> Maybe TremoloType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> Maybe AboveBelow
 -> Maybe SmuflGlyphName
 -> Tremolo)
-> XParse TremoloMarks
-> XParse
     (Maybe TremoloType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse TremoloMarks) -> XParse TremoloMarks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TremoloMarks
parseTremoloMarks)
        XParse
  (Maybe TremoloType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe TremoloType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TremoloType -> XParse (Maybe TremoloType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse TremoloType) -> XParse TremoloType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TremoloType
parseTremoloType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe FontSize)
-> XParse
     (Maybe FontWeight
      -> Maybe Color
      -> Maybe AboveBelow
      -> Maybe SmuflGlyphName
      -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse
  (Maybe FontWeight
   -> Maybe Color
   -> Maybe AboveBelow
   -> Maybe SmuflGlyphName
   -> Tremolo)
-> XParse (Maybe FontWeight)
-> XParse
     (Maybe Color
      -> Maybe AboveBelow -> Maybe SmuflGlyphName -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse
  (Maybe Color
   -> Maybe AboveBelow -> Maybe SmuflGlyphName -> Tremolo)
-> XParse (Maybe Color)
-> XParse (Maybe AboveBelow -> Maybe SmuflGlyphName -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe AboveBelow -> Maybe SmuflGlyphName -> Tremolo)
-> XParse (Maybe AboveBelow)
-> XParse (Maybe SmuflGlyphName -> Tremolo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse (Maybe SmuflGlyphName -> Tremolo)
-> XParse (Maybe SmuflGlyphName) -> XParse Tremolo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SmuflGlyphName -> XParse (Maybe SmuflGlyphName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"smufl") XParse String
-> (String -> XParse SmuflGlyphName) -> XParse SmuflGlyphName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SmuflGlyphName
parseSmuflGlyphName)

-- | Smart constructor for 'Tremolo'
mkTremolo :: TremoloMarks -> Tremolo
mkTremolo :: TremoloMarks -> Tremolo
mkTremolo TremoloMarks
a = TremoloMarks
-> Maybe TremoloType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> Maybe AboveBelow
-> Maybe SmuflGlyphName
-> Tremolo
Tremolo TremoloMarks
a Maybe TremoloType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe SmuflGlyphName
forall a. Maybe a
Nothing

-- | @tuplet@ /(complex)/
--
-- A tuplet element is present when a tuplet is to be displayed graphically, in addition to the sound data provided by the time-modification elements. The number attribute is used to distinguish nested tuplets. The bracket attribute is used to indicate the presence of a bracket. If unspecified, the results are implementation-dependent. The line-shape attribute is used to specify whether the bracket is straight or in the older curved or slurred style. It is straight by default.
-- 
-- Whereas a time-modification element shows how the cumulative, sounding effect of tuplets and double-note tremolos compare to the written note type, the tuplet element describes how this is displayed. The tuplet element also provides more detailed representation information than the time-modification element, and is needed to represent nested tuplets and other complex tuplets accurately.
-- 
-- The show-number attribute is used to display either the number of actual notes, the number of both actual and normal notes, or neither. It is actual by default. The show-type attribute is used to display either the actual type, both the actual and normal types, or neither. It is none by default.
data Tuplet = 
      Tuplet {
          Tuplet -> StartStop
tupletType :: StartStop -- ^ /type/ attribute
        , Tuplet -> Maybe NumberLevel
tupletNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Tuplet -> Maybe YesNo
tupletBracket :: (Maybe YesNo) -- ^ /bracket/ attribute
        , Tuplet -> Maybe ShowTuplet
tupletShowNumber :: (Maybe ShowTuplet) -- ^ /show-number/ attribute
        , Tuplet -> Maybe ShowTuplet
tupletShowType :: (Maybe ShowTuplet) -- ^ /show-type/ attribute
        , Tuplet -> Maybe LineShape
tupletLineShape :: (Maybe LineShape) -- ^ /line-shape/ attribute
        , Tuplet -> Maybe Tenths
tupletDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Tuplet -> Maybe Tenths
tupletDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Tuplet -> Maybe Tenths
tupletRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Tuplet -> Maybe Tenths
tupletRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Tuplet -> Maybe AboveBelow
tupletPlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , Tuplet -> Maybe ID
tupletId :: (Maybe ID) -- ^ /id/ attribute
        , Tuplet -> Maybe TupletPortion
tupletTupletActual :: (Maybe TupletPortion) -- ^ /tuplet-actual/ child element
        , Tuplet -> Maybe TupletPortion
tupletTupletNormal :: (Maybe TupletPortion) -- ^ /tuplet-normal/ child element
       }
    deriving (Tuplet -> Tuplet -> Bool
(Tuplet -> Tuplet -> Bool)
-> (Tuplet -> Tuplet -> Bool) -> Eq Tuplet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuplet -> Tuplet -> Bool
$c/= :: Tuplet -> Tuplet -> Bool
== :: Tuplet -> Tuplet -> Bool
$c== :: Tuplet -> Tuplet -> Bool
Eq,Typeable,(forall x. Tuplet -> Rep Tuplet x)
-> (forall x. Rep Tuplet x -> Tuplet) -> Generic Tuplet
forall x. Rep Tuplet x -> Tuplet
forall x. Tuplet -> Rep Tuplet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tuplet x -> Tuplet
$cfrom :: forall x. Tuplet -> Rep Tuplet x
Generic,Int -> Tuplet -> ShowS
[Tuplet] -> ShowS
Tuplet -> String
(Int -> Tuplet -> ShowS)
-> (Tuplet -> String) -> ([Tuplet] -> ShowS) -> Show Tuplet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tuplet] -> ShowS
$cshowList :: [Tuplet] -> ShowS
show :: Tuplet -> String
$cshow :: Tuplet -> String
showsPrec :: Int -> Tuplet -> ShowS
$cshowsPrec :: Int -> Tuplet -> ShowS
Show)
instance EmitXml Tuplet where
    emitXml :: Tuplet -> XmlRep
emitXml (Tuplet StartStop
a Maybe NumberLevel
b Maybe YesNo
c Maybe ShowTuplet
d Maybe ShowTuplet
e Maybe LineShape
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe AboveBelow
k Maybe ID
l Maybe TupletPortion
m Maybe TupletPortion
n) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStop -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStop
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ShowTuplet -> XmlRep) -> Maybe ShowTuplet -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ShowTuplet -> XmlRep) -> ShowTuplet -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowTuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ShowTuplet
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ShowTuplet -> XmlRep) -> Maybe ShowTuplet -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"show-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ShowTuplet -> XmlRep) -> ShowTuplet -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ShowTuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ShowTuplet
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineShape -> XmlRep) -> Maybe LineShape -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-shape" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineShape -> XmlRep) -> LineShape -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineShape -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineShape
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
l])
        ([XmlRep
-> (TupletPortion -> XmlRep) -> Maybe TupletPortion -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet-actual" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TupletPortion -> XmlRep) -> TupletPortion -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TupletPortion -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TupletPortion
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (TupletPortion -> XmlRep) -> Maybe TupletPortion -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet-normal" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TupletPortion -> XmlRep) -> TupletPortion -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TupletPortion -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TupletPortion
n])
parseTuplet :: P.XParse Tuplet
parseTuplet :: XParse Tuplet
parseTuplet = 
      StartStop
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe ShowTuplet
-> Maybe ShowTuplet
-> Maybe LineShape
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe ID
-> Maybe TupletPortion
-> Maybe TupletPortion
-> Tuplet
Tuplet
        (StartStop
 -> Maybe NumberLevel
 -> Maybe YesNo
 -> Maybe ShowTuplet
 -> Maybe ShowTuplet
 -> Maybe LineShape
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe ID
 -> Maybe TupletPortion
 -> Maybe TupletPortion
 -> Tuplet)
-> XParse StartStop
-> XParse
     (Maybe NumberLevel
      -> Maybe YesNo
      -> Maybe ShowTuplet
      -> Maybe ShowTuplet
      -> Maybe LineShape
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse StartStop) -> XParse StartStop
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStop
parseStartStop)
        XParse
  (Maybe NumberLevel
   -> Maybe YesNo
   -> Maybe ShowTuplet
   -> Maybe ShowTuplet
   -> Maybe LineShape
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe YesNo
      -> Maybe ShowTuplet
      -> Maybe ShowTuplet
      -> Maybe LineShape
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe YesNo
   -> Maybe ShowTuplet
   -> Maybe ShowTuplet
   -> Maybe LineShape
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe ShowTuplet
      -> Maybe ShowTuplet
      -> Maybe LineShape
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"bracket") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe ShowTuplet
   -> Maybe ShowTuplet
   -> Maybe LineShape
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe ShowTuplet)
-> XParse
     (Maybe ShowTuplet
      -> Maybe LineShape
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ShowTuplet -> XParse (Maybe ShowTuplet)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"show-number") XParse String -> (String -> XParse ShowTuplet) -> XParse ShowTuplet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ShowTuplet
parseShowTuplet)
        XParse
  (Maybe ShowTuplet
   -> Maybe LineShape
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe ShowTuplet)
-> XParse
     (Maybe LineShape
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ShowTuplet -> XParse (Maybe ShowTuplet)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"show-type") XParse String -> (String -> XParse ShowTuplet) -> XParse ShowTuplet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ShowTuplet
parseShowTuplet)
        XParse
  (Maybe LineShape
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe LineShape)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineShape -> XParse (Maybe LineShape)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-shape") XParse String -> (String -> XParse LineShape) -> XParse LineShape
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineShape
parseLineShape)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow
      -> Maybe ID
      -> Maybe TupletPortion
      -> Maybe TupletPortion
      -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow
   -> Maybe ID
   -> Maybe TupletPortion
   -> Maybe TupletPortion
   -> Tuplet)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe ID -> Maybe TupletPortion -> Maybe TupletPortion -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe ID -> Maybe TupletPortion -> Maybe TupletPortion -> Tuplet)
-> XParse (Maybe ID)
-> XParse (Maybe TupletPortion -> Maybe TupletPortion -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)
        XParse (Maybe TupletPortion -> Maybe TupletPortion -> Tuplet)
-> XParse (Maybe TupletPortion)
-> XParse (Maybe TupletPortion -> Tuplet)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TupletPortion -> XParse (Maybe TupletPortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TupletPortion -> XParse TupletPortion
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet-actual") (XParse TupletPortion
parseTupletPortion))
        XParse (Maybe TupletPortion -> Tuplet)
-> XParse (Maybe TupletPortion) -> XParse Tuplet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TupletPortion -> XParse (Maybe TupletPortion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TupletPortion -> XParse TupletPortion
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet-normal") (XParse TupletPortion
parseTupletPortion))

-- | Smart constructor for 'Tuplet'
mkTuplet :: StartStop -> Tuplet
mkTuplet :: StartStop -> Tuplet
mkTuplet StartStop
a = StartStop
-> Maybe NumberLevel
-> Maybe YesNo
-> Maybe ShowTuplet
-> Maybe ShowTuplet
-> Maybe LineShape
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe ID
-> Maybe TupletPortion
-> Maybe TupletPortion
-> Tuplet
Tuplet StartStop
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe ShowTuplet
forall a. Maybe a
Nothing Maybe ShowTuplet
forall a. Maybe a
Nothing Maybe LineShape
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing Maybe TupletPortion
forall a. Maybe a
Nothing Maybe TupletPortion
forall a. Maybe a
Nothing

-- | @tuplet-dot@ /(complex)/
--
-- The tuplet-dot type is used to specify dotted normal tuplet types.
data TupletDot = 
      TupletDot {
          TupletDot -> Maybe CommaSeparatedText
tupletDotFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , TupletDot -> Maybe FontStyle
tupletDotFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , TupletDot -> Maybe FontSize
tupletDotFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , TupletDot -> Maybe FontWeight
tupletDotFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , TupletDot -> Maybe Color
tupletDotColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (TupletDot -> TupletDot -> Bool
(TupletDot -> TupletDot -> Bool)
-> (TupletDot -> TupletDot -> Bool) -> Eq TupletDot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TupletDot -> TupletDot -> Bool
$c/= :: TupletDot -> TupletDot -> Bool
== :: TupletDot -> TupletDot -> Bool
$c== :: TupletDot -> TupletDot -> Bool
Eq,Typeable,(forall x. TupletDot -> Rep TupletDot x)
-> (forall x. Rep TupletDot x -> TupletDot) -> Generic TupletDot
forall x. Rep TupletDot x -> TupletDot
forall x. TupletDot -> Rep TupletDot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TupletDot x -> TupletDot
$cfrom :: forall x. TupletDot -> Rep TupletDot x
Generic,Int -> TupletDot -> ShowS
[TupletDot] -> ShowS
TupletDot -> String
(Int -> TupletDot -> ShowS)
-> (TupletDot -> String)
-> ([TupletDot] -> ShowS)
-> Show TupletDot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TupletDot] -> ShowS
$cshowList :: [TupletDot] -> ShowS
show :: TupletDot -> String
$cshow :: TupletDot -> String
showsPrec :: Int -> TupletDot -> ShowS
$cshowsPrec :: Int -> TupletDot -> ShowS
Show)
instance EmitXml TupletDot where
    emitXml :: TupletDot -> XmlRep
emitXml (TupletDot Maybe CommaSeparatedText
a Maybe FontStyle
b Maybe FontSize
c Maybe FontWeight
d Maybe Color
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
e])
        []
parseTupletDot :: P.XParse TupletDot
parseTupletDot :: XParse TupletDot
parseTupletDot = 
      Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletDot
TupletDot
        (Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> TupletDot)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletDot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletDot)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletDot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletDot)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> TupletDot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> TupletDot)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> TupletDot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> TupletDot)
-> XParse (Maybe Color) -> XParse TupletDot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'TupletDot'
mkTupletDot :: TupletDot
mkTupletDot :: TupletDot
mkTupletDot = Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletDot
TupletDot Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @tuplet-number@ /(complex)/
--
-- The tuplet-number type indicates the number of notes for this portion of the tuplet.
data TupletNumber = 
      TupletNumber {
          TupletNumber -> NonNegativeInteger
tupletNumberNonNegativeInteger :: NonNegativeInteger -- ^ text content
        , TupletNumber -> Maybe CommaSeparatedText
tupletNumberFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , TupletNumber -> Maybe FontStyle
tupletNumberFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , TupletNumber -> Maybe FontSize
tupletNumberFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , TupletNumber -> Maybe FontWeight
tupletNumberFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , TupletNumber -> Maybe Color
tupletNumberColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (TupletNumber -> TupletNumber -> Bool
(TupletNumber -> TupletNumber -> Bool)
-> (TupletNumber -> TupletNumber -> Bool) -> Eq TupletNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TupletNumber -> TupletNumber -> Bool
$c/= :: TupletNumber -> TupletNumber -> Bool
== :: TupletNumber -> TupletNumber -> Bool
$c== :: TupletNumber -> TupletNumber -> Bool
Eq,Typeable,(forall x. TupletNumber -> Rep TupletNumber x)
-> (forall x. Rep TupletNumber x -> TupletNumber)
-> Generic TupletNumber
forall x. Rep TupletNumber x -> TupletNumber
forall x. TupletNumber -> Rep TupletNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TupletNumber x -> TupletNumber
$cfrom :: forall x. TupletNumber -> Rep TupletNumber x
Generic,Int -> TupletNumber -> ShowS
[TupletNumber] -> ShowS
TupletNumber -> String
(Int -> TupletNumber -> ShowS)
-> (TupletNumber -> String)
-> ([TupletNumber] -> ShowS)
-> Show TupletNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TupletNumber] -> ShowS
$cshowList :: [TupletNumber] -> ShowS
show :: TupletNumber -> String
$cshow :: TupletNumber -> String
showsPrec :: Int -> TupletNumber -> ShowS
$cshowsPrec :: Int -> TupletNumber -> ShowS
Show)
instance EmitXml TupletNumber where
    emitXml :: TupletNumber -> XmlRep
emitXml (TupletNumber NonNegativeInteger
a Maybe CommaSeparatedText
b Maybe FontStyle
c Maybe FontSize
d Maybe FontWeight
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NonNegativeInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonNegativeInteger
a)
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseTupletNumber :: P.XParse TupletNumber
parseTupletNumber :: XParse TupletNumber
parseTupletNumber = 
      NonNegativeInteger
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletNumber
TupletNumber
        (NonNegativeInteger
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> TupletNumber)
-> XParse NonNegativeInteger
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> TupletNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NonNegativeInteger)
-> XParse NonNegativeInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NonNegativeInteger
parseNonNegativeInteger)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> TupletNumber)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> TupletNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> TupletNumber)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletNumber)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> TupletNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> TupletNumber)
-> XParse (Maybe FontWeight)
-> XParse (Maybe Color -> TupletNumber)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> TupletNumber)
-> XParse (Maybe Color) -> XParse TupletNumber
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'TupletNumber'
mkTupletNumber :: NonNegativeInteger -> TupletNumber
mkTupletNumber :: NonNegativeInteger -> TupletNumber
mkTupletNumber NonNegativeInteger
a = NonNegativeInteger
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletNumber
TupletNumber NonNegativeInteger
a Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @tuplet-portion@ /(complex)/
--
-- The tuplet-portion type provides optional full control over tuplet specifications. It allows the number and note type (including dots) to be set for the actual and normal portions of a single tuplet. If any of these elements are absent, their values are based on the time-modification element.
data TupletPortion = 
      TupletPortion {
          TupletPortion -> Maybe TupletNumber
tupletPortionTupletNumber :: (Maybe TupletNumber) -- ^ /tuplet-number/ child element
        , TupletPortion -> Maybe TupletType
tupletPortionTupletType :: (Maybe TupletType) -- ^ /tuplet-type/ child element
        , TupletPortion -> [TupletDot]
tupletPortionTupletDot :: [TupletDot] -- ^ /tuplet-dot/ child element
       }
    deriving (TupletPortion -> TupletPortion -> Bool
(TupletPortion -> TupletPortion -> Bool)
-> (TupletPortion -> TupletPortion -> Bool) -> Eq TupletPortion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TupletPortion -> TupletPortion -> Bool
$c/= :: TupletPortion -> TupletPortion -> Bool
== :: TupletPortion -> TupletPortion -> Bool
$c== :: TupletPortion -> TupletPortion -> Bool
Eq,Typeable,(forall x. TupletPortion -> Rep TupletPortion x)
-> (forall x. Rep TupletPortion x -> TupletPortion)
-> Generic TupletPortion
forall x. Rep TupletPortion x -> TupletPortion
forall x. TupletPortion -> Rep TupletPortion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TupletPortion x -> TupletPortion
$cfrom :: forall x. TupletPortion -> Rep TupletPortion x
Generic,Int -> TupletPortion -> ShowS
[TupletPortion] -> ShowS
TupletPortion -> String
(Int -> TupletPortion -> ShowS)
-> (TupletPortion -> String)
-> ([TupletPortion] -> ShowS)
-> Show TupletPortion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TupletPortion] -> ShowS
$cshowList :: [TupletPortion] -> ShowS
show :: TupletPortion -> String
$cshow :: TupletPortion -> String
showsPrec :: Int -> TupletPortion -> ShowS
$cshowsPrec :: Int -> TupletPortion -> ShowS
Show)
instance EmitXml TupletPortion where
    emitXml :: TupletPortion -> XmlRep
emitXml (TupletPortion Maybe TupletNumber
a Maybe TupletType
b [TupletDot]
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (TupletNumber -> XmlRep) -> Maybe TupletNumber -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TupletNumber -> XmlRep) -> TupletNumber -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TupletNumber -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TupletNumber
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TupletType -> XmlRep) -> Maybe TupletType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TupletType -> XmlRep) -> TupletType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TupletType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TupletType
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (TupletDot -> XmlRep) -> [TupletDot] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TupletDot -> XmlRep) -> TupletDot -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TupletDot -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [TupletDot]
c)
parseTupletPortion :: P.XParse TupletPortion
parseTupletPortion :: XParse TupletPortion
parseTupletPortion = 
      Maybe TupletNumber
-> Maybe TupletType -> [TupletDot] -> TupletPortion
TupletPortion
        (Maybe TupletNumber
 -> Maybe TupletType -> [TupletDot] -> TupletPortion)
-> XParse (Maybe TupletNumber)
-> XParse (Maybe TupletType -> [TupletDot] -> TupletPortion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TupletNumber -> XParse (Maybe TupletNumber)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TupletNumber -> XParse TupletNumber
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet-number") (XParse TupletNumber
parseTupletNumber))
        XParse (Maybe TupletType -> [TupletDot] -> TupletPortion)
-> XParse (Maybe TupletType)
-> XParse ([TupletDot] -> TupletPortion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TupletType -> XParse (Maybe TupletType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse TupletType -> XParse TupletType
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet-type") (XParse TupletType
parseTupletType))
        XParse ([TupletDot] -> TupletPortion)
-> XParse [TupletDot] -> XParse TupletPortion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TupletDot -> XParse [TupletDot]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse TupletDot -> XParse TupletDot
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet-dot") (XParse TupletDot
parseTupletDot))

-- | Smart constructor for 'TupletPortion'
mkTupletPortion :: TupletPortion
mkTupletPortion :: TupletPortion
mkTupletPortion = Maybe TupletNumber
-> Maybe TupletType -> [TupletDot] -> TupletPortion
TupletPortion Maybe TupletNumber
forall a. Maybe a
Nothing Maybe TupletType
forall a. Maybe a
Nothing []

-- | @tuplet-type@ /(complex)/
--
-- The tuplet-type type indicates the graphical note type of the notes for this portion of the tuplet.
data TupletType = 
      TupletType {
          TupletType -> NoteTypeValue
tupletTypeNoteTypeValue :: NoteTypeValue -- ^ text content
        , TupletType -> Maybe CommaSeparatedText
tupletTypeFontFamily :: (Maybe CommaSeparatedText) -- ^ /font-family/ attribute
        , TupletType -> Maybe FontStyle
tupletTypeFontStyle :: (Maybe FontStyle) -- ^ /font-style/ attribute
        , TupletType -> Maybe FontSize
tupletTypeFontSize :: (Maybe FontSize) -- ^ /font-size/ attribute
        , TupletType -> Maybe FontWeight
tupletTypeFontWeight :: (Maybe FontWeight) -- ^ /font-weight/ attribute
        , TupletType -> Maybe Color
tupletTypeColor :: (Maybe Color) -- ^ /color/ attribute
       }
    deriving (TupletType -> TupletType -> Bool
(TupletType -> TupletType -> Bool)
-> (TupletType -> TupletType -> Bool) -> Eq TupletType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TupletType -> TupletType -> Bool
$c/= :: TupletType -> TupletType -> Bool
== :: TupletType -> TupletType -> Bool
$c== :: TupletType -> TupletType -> Bool
Eq,Typeable,(forall x. TupletType -> Rep TupletType x)
-> (forall x. Rep TupletType x -> TupletType) -> Generic TupletType
forall x. Rep TupletType x -> TupletType
forall x. TupletType -> Rep TupletType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TupletType x -> TupletType
$cfrom :: forall x. TupletType -> Rep TupletType x
Generic,Int -> TupletType -> ShowS
[TupletType] -> ShowS
TupletType -> String
(Int -> TupletType -> ShowS)
-> (TupletType -> String)
-> ([TupletType] -> ShowS)
-> Show TupletType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TupletType] -> ShowS
$cshowList :: [TupletType] -> ShowS
show :: TupletType -> String
$cshow :: TupletType -> String
showsPrec :: Int -> TupletType -> ShowS
$cshowsPrec :: Int -> TupletType -> ShowS
Show)
instance EmitXml TupletType where
    emitXml :: TupletType -> XmlRep
emitXml (TupletType NoteTypeValue
a Maybe CommaSeparatedText
b Maybe FontStyle
c Maybe FontSize
d Maybe FontWeight
e Maybe Color
f) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)
        ([XmlRep
-> (CommaSeparatedText -> XmlRep)
-> Maybe CommaSeparatedText
-> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-family" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (CommaSeparatedText -> XmlRep) -> CommaSeparatedText -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.CommaSeparatedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe CommaSeparatedText
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontStyle -> XmlRep) -> Maybe FontStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontStyle -> XmlRep) -> FontStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontStyle
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontSize -> XmlRep) -> Maybe FontSize -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-size" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (FontSize -> XmlRep) -> FontSize -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontSize -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontSize
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (FontWeight -> XmlRep) -> Maybe FontWeight -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"font-weight" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FontWeight -> XmlRep) -> FontWeight -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontWeight -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe FontWeight
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
f])
        []
parseTupletType :: P.XParse TupletType
parseTupletType :: XParse TupletType
parseTupletType = 
      NoteTypeValue
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletType
TupletType
        (NoteTypeValue
 -> Maybe CommaSeparatedText
 -> Maybe FontStyle
 -> Maybe FontSize
 -> Maybe FontWeight
 -> Maybe Color
 -> TupletType)
-> XParse NoteTypeValue
-> XParse
     (Maybe CommaSeparatedText
      -> Maybe FontStyle
      -> Maybe FontSize
      -> Maybe FontWeight
      -> Maybe Color
      -> TupletType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue)
        XParse
  (Maybe CommaSeparatedText
   -> Maybe FontStyle
   -> Maybe FontSize
   -> Maybe FontWeight
   -> Maybe Color
   -> TupletType)
-> XParse (Maybe CommaSeparatedText)
-> XParse
     (Maybe FontStyle
      -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse CommaSeparatedText -> XParse (Maybe CommaSeparatedText)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-family") XParse String
-> (String -> XParse CommaSeparatedText)
-> XParse CommaSeparatedText
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CommaSeparatedText
parseCommaSeparatedText)
        XParse
  (Maybe FontStyle
   -> Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletType)
-> XParse (Maybe FontStyle)
-> XParse
     (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontStyle -> XParse (Maybe FontStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-style") XParse String -> (String -> XParse FontStyle) -> XParse FontStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontStyle
parseFontStyle)
        XParse
  (Maybe FontSize -> Maybe FontWeight -> Maybe Color -> TupletType)
-> XParse (Maybe FontSize)
-> XParse (Maybe FontWeight -> Maybe Color -> TupletType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontSize -> XParse (Maybe FontSize)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-size") XParse String -> (String -> XParse FontSize) -> XParse FontSize
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontSize
parseFontSize)
        XParse (Maybe FontWeight -> Maybe Color -> TupletType)
-> XParse (Maybe FontWeight) -> XParse (Maybe Color -> TupletType)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FontWeight -> XParse (Maybe FontWeight)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"font-weight") XParse String -> (String -> XParse FontWeight) -> XParse FontWeight
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse FontWeight
parseFontWeight)
        XParse (Maybe Color -> TupletType)
-> XParse (Maybe Color) -> XParse TupletType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)

-- | Smart constructor for 'TupletType'
mkTupletType :: NoteTypeValue -> TupletType
mkTupletType :: NoteTypeValue -> TupletType
mkTupletType NoteTypeValue
a = NoteTypeValue
-> Maybe CommaSeparatedText
-> Maybe FontStyle
-> Maybe FontSize
-> Maybe FontWeight
-> Maybe Color
-> TupletType
TupletType NoteTypeValue
a Maybe CommaSeparatedText
forall a. Maybe a
Nothing Maybe FontStyle
forall a. Maybe a
Nothing Maybe FontSize
forall a. Maybe a
Nothing Maybe FontWeight
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing

-- | @typed-text@ /(complex)/
--
-- The typed-text type represents a text element with a type attributes.
data TypedText = 
      TypedText {
          TypedText -> String
typedTextString :: String -- ^ text content
        , TypedText -> Maybe Token
typedTextType :: (Maybe Token) -- ^ /type/ attribute
       }
    deriving (TypedText -> TypedText -> Bool
(TypedText -> TypedText -> Bool)
-> (TypedText -> TypedText -> Bool) -> Eq TypedText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypedText -> TypedText -> Bool
$c/= :: TypedText -> TypedText -> Bool
== :: TypedText -> TypedText -> Bool
$c== :: TypedText -> TypedText -> Bool
Eq,Typeable,(forall x. TypedText -> Rep TypedText x)
-> (forall x. Rep TypedText x -> TypedText) -> Generic TypedText
forall x. Rep TypedText x -> TypedText
forall x. TypedText -> Rep TypedText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypedText x -> TypedText
$cfrom :: forall x. TypedText -> Rep TypedText x
Generic,Int -> TypedText -> ShowS
[TypedText] -> ShowS
TypedText -> String
(Int -> TypedText -> ShowS)
-> (TypedText -> String)
-> ([TypedText] -> ShowS)
-> Show TypedText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypedText] -> ShowS
$cshowList :: [TypedText] -> ShowS
show :: TypedText -> String
$cshow :: TypedText -> String
showsPrec :: Int -> TypedText -> ShowS
$cshowsPrec :: Int -> TypedText -> ShowS
Show)
instance EmitXml TypedText where
    emitXml :: TypedText -> XmlRep
emitXml (TypedText String
a Maybe Token
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)
        ([XmlRep -> (Token -> XmlRep) -> Maybe Token -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Token -> XmlRep) -> Token -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Token -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Token
b])
        []
parseTypedText :: P.XParse TypedText
parseTypedText :: XParse TypedText
parseTypedText = 
      String -> Maybe Token -> TypedText
TypedText
        (String -> Maybe Token -> TypedText)
-> XParse String -> XParse (Maybe Token -> TypedText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return)
        XParse (Maybe Token -> TypedText)
-> XParse (Maybe Token) -> XParse TypedText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Token -> XParse (Maybe Token)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse Token) -> XParse Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Token
parseToken)

-- | Smart constructor for 'TypedText'
mkTypedText :: String -> TypedText
mkTypedText :: String -> TypedText
mkTypedText String
a = String -> Maybe Token -> TypedText
TypedText String
a Maybe Token
forall a. Maybe a
Nothing

-- | @unpitched@ /(complex)/
--
-- The unpitched type represents musical elements that are notated on the staff but lack definite pitch, such as unpitched percussion and speaking voice.
data Unpitched = 
      Unpitched {
          Unpitched -> Maybe DisplayStepOctave
unpitchedDisplayStepOctave :: (Maybe DisplayStepOctave)
       }
    deriving (Unpitched -> Unpitched -> Bool
(Unpitched -> Unpitched -> Bool)
-> (Unpitched -> Unpitched -> Bool) -> Eq Unpitched
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unpitched -> Unpitched -> Bool
$c/= :: Unpitched -> Unpitched -> Bool
== :: Unpitched -> Unpitched -> Bool
$c== :: Unpitched -> Unpitched -> Bool
Eq,Typeable,(forall x. Unpitched -> Rep Unpitched x)
-> (forall x. Rep Unpitched x -> Unpitched) -> Generic Unpitched
forall x. Rep Unpitched x -> Unpitched
forall x. Unpitched -> Rep Unpitched x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unpitched x -> Unpitched
$cfrom :: forall x. Unpitched -> Rep Unpitched x
Generic,Int -> Unpitched -> ShowS
[Unpitched] -> ShowS
Unpitched -> String
(Int -> Unpitched -> ShowS)
-> (Unpitched -> String)
-> ([Unpitched] -> ShowS)
-> Show Unpitched
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unpitched] -> ShowS
$cshowList :: [Unpitched] -> ShowS
show :: Unpitched -> String
$cshow :: Unpitched -> String
showsPrec :: Int -> Unpitched -> ShowS
$cshowsPrec :: Int -> Unpitched -> ShowS
Show)
instance EmitXml Unpitched where
    emitXml :: Unpitched -> XmlRep
emitXml (Unpitched Maybe DisplayStepOctave
a) =
      [XmlRep] -> XmlRep
XReps [Maybe DisplayStepOctave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe DisplayStepOctave
a]
parseUnpitched :: P.XParse Unpitched
parseUnpitched :: XParse Unpitched
parseUnpitched = 
      Maybe DisplayStepOctave -> Unpitched
Unpitched
        (Maybe DisplayStepOctave -> Unpitched)
-> XParse (Maybe DisplayStepOctave) -> XParse Unpitched
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse DisplayStepOctave -> XParse (Maybe DisplayStepOctave)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse DisplayStepOctave
parseDisplayStepOctave)

-- | Smart constructor for 'Unpitched'
mkUnpitched :: Unpitched
mkUnpitched :: Unpitched
mkUnpitched = Maybe DisplayStepOctave -> Unpitched
Unpitched Maybe DisplayStepOctave
forall a. Maybe a
Nothing

-- | @virtual-instrument@ /(complex)/
--
-- The virtual-instrument element defines a specific virtual instrument used for an instrument sound.
data VirtualInstrument = 
      VirtualInstrument {
          VirtualInstrument -> Maybe String
virtualInstrumentVirtualLibrary :: (Maybe String) -- ^ /virtual-library/ child element
        , VirtualInstrument -> Maybe String
virtualInstrumentVirtualName :: (Maybe String) -- ^ /virtual-name/ child element
       }
    deriving (VirtualInstrument -> VirtualInstrument -> Bool
(VirtualInstrument -> VirtualInstrument -> Bool)
-> (VirtualInstrument -> VirtualInstrument -> Bool)
-> Eq VirtualInstrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VirtualInstrument -> VirtualInstrument -> Bool
$c/= :: VirtualInstrument -> VirtualInstrument -> Bool
== :: VirtualInstrument -> VirtualInstrument -> Bool
$c== :: VirtualInstrument -> VirtualInstrument -> Bool
Eq,Typeable,(forall x. VirtualInstrument -> Rep VirtualInstrument x)
-> (forall x. Rep VirtualInstrument x -> VirtualInstrument)
-> Generic VirtualInstrument
forall x. Rep VirtualInstrument x -> VirtualInstrument
forall x. VirtualInstrument -> Rep VirtualInstrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VirtualInstrument x -> VirtualInstrument
$cfrom :: forall x. VirtualInstrument -> Rep VirtualInstrument x
Generic,Int -> VirtualInstrument -> ShowS
[VirtualInstrument] -> ShowS
VirtualInstrument -> String
(Int -> VirtualInstrument -> ShowS)
-> (VirtualInstrument -> String)
-> ([VirtualInstrument] -> ShowS)
-> Show VirtualInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualInstrument] -> ShowS
$cshowList :: [VirtualInstrument] -> ShowS
show :: VirtualInstrument -> String
$cshow :: VirtualInstrument -> String
showsPrec :: Int -> VirtualInstrument -> ShowS
$cshowsPrec :: Int -> VirtualInstrument -> ShowS
Show)
instance EmitXml VirtualInstrument where
    emitXml :: VirtualInstrument -> XmlRep
emitXml (VirtualInstrument Maybe String
a Maybe String
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"virtual-library" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"virtual-name" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
b])
parseVirtualInstrument :: P.XParse VirtualInstrument
parseVirtualInstrument :: XParse VirtualInstrument
parseVirtualInstrument = 
      Maybe String -> Maybe String -> VirtualInstrument
VirtualInstrument
        (Maybe String -> Maybe String -> VirtualInstrument)
-> XParse (Maybe String)
-> XParse (Maybe String -> VirtualInstrument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"virtual-library") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse (Maybe String -> VirtualInstrument)
-> XParse (Maybe String) -> XParse VirtualInstrument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"virtual-name") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'VirtualInstrument'
mkVirtualInstrument :: VirtualInstrument
mkVirtualInstrument :: VirtualInstrument
mkVirtualInstrument = Maybe String -> Maybe String -> VirtualInstrument
VirtualInstrument Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing

-- | @wavy-line@ /(complex)/
--
-- Wavy lines are one way to indicate trills. When used with a barline element, they should always have type="continue" set.
data WavyLine = 
      WavyLine {
          WavyLine -> StartStopContinue
wavyLineType :: StartStopContinue -- ^ /type/ attribute
        , WavyLine -> Maybe NumberLevel
wavyLineNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , WavyLine -> Maybe Tenths
wavyLineDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , WavyLine -> Maybe Tenths
wavyLineDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , WavyLine -> Maybe Tenths
wavyLineRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , WavyLine -> Maybe Tenths
wavyLineRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , WavyLine -> Maybe AboveBelow
wavyLinePlacement :: (Maybe AboveBelow) -- ^ /placement/ attribute
        , WavyLine -> Maybe Color
wavyLineColor :: (Maybe Color) -- ^ /color/ attribute
        , WavyLine -> Maybe StartNote
wavyLineStartNote :: (Maybe StartNote) -- ^ /start-note/ attribute
        , WavyLine -> Maybe TrillStep
wavyLineTrillStep :: (Maybe TrillStep) -- ^ /trill-step/ attribute
        , WavyLine -> Maybe TwoNoteTurn
wavyLineTwoNoteTurn :: (Maybe TwoNoteTurn) -- ^ /two-note-turn/ attribute
        , WavyLine -> Maybe YesNo
wavyLineAccelerate :: (Maybe YesNo) -- ^ /accelerate/ attribute
        , WavyLine -> Maybe TrillBeats
wavyLineBeats :: (Maybe TrillBeats) -- ^ /beats/ attribute
        , WavyLine -> Maybe Percent
wavyLineSecondBeat :: (Maybe Percent) -- ^ /second-beat/ attribute
        , WavyLine -> Maybe Percent
wavyLineLastBeat :: (Maybe Percent) -- ^ /last-beat/ attribute
       }
    deriving (WavyLine -> WavyLine -> Bool
(WavyLine -> WavyLine -> Bool)
-> (WavyLine -> WavyLine -> Bool) -> Eq WavyLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WavyLine -> WavyLine -> Bool
$c/= :: WavyLine -> WavyLine -> Bool
== :: WavyLine -> WavyLine -> Bool
$c== :: WavyLine -> WavyLine -> Bool
Eq,Typeable,(forall x. WavyLine -> Rep WavyLine x)
-> (forall x. Rep WavyLine x -> WavyLine) -> Generic WavyLine
forall x. Rep WavyLine x -> WavyLine
forall x. WavyLine -> Rep WavyLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WavyLine x -> WavyLine
$cfrom :: forall x. WavyLine -> Rep WavyLine x
Generic,Int -> WavyLine -> ShowS
[WavyLine] -> ShowS
WavyLine -> String
(Int -> WavyLine -> ShowS)
-> (WavyLine -> String) -> ([WavyLine] -> ShowS) -> Show WavyLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WavyLine] -> ShowS
$cshowList :: [WavyLine] -> ShowS
show :: WavyLine -> String
$cshow :: WavyLine -> String
showsPrec :: Int -> WavyLine -> ShowS
$cshowsPrec :: Int -> WavyLine -> ShowS
Show)
instance EmitXml WavyLine where
    emitXml :: WavyLine -> XmlRep
emitXml (WavyLine StartStopContinue
a Maybe NumberLevel
b Maybe Tenths
c Maybe Tenths
d Maybe Tenths
e Maybe Tenths
f Maybe AboveBelow
g Maybe Color
h Maybe StartNote
i Maybe TrillStep
j Maybe TwoNoteTurn
k Maybe YesNo
l Maybe TrillBeats
m Maybe Percent
n Maybe Percent
o) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (StartStopContinue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StartStopContinue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (AboveBelow -> XmlRep) -> Maybe AboveBelow -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"placement" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AboveBelow -> XmlRep) -> AboveBelow -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AboveBelow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe AboveBelow
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (StartNote -> XmlRep) -> Maybe StartNote -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"start-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (StartNote -> XmlRep) -> StartNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StartNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe StartNote
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillStep -> XmlRep) -> Maybe TrillStep -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"trill-step" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (TrillStep -> XmlRep) -> TrillStep -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillStep -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillStep
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TwoNoteTurn -> XmlRep) -> Maybe TwoNoteTurn -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"two-note-turn" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TwoNoteTurn -> XmlRep) -> TwoNoteTurn -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TwoNoteTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TwoNoteTurn
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"accelerate" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (TrillBeats -> XmlRep) -> Maybe TrillBeats -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (TrillBeats -> XmlRep) -> TrillBeats -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.TrillBeats -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe TrillBeats
m] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"second-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
n] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Percent -> XmlRep) -> Maybe Percent -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"last-beat" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Percent -> XmlRep) -> Percent -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Percent
o])
        []
parseWavyLine :: P.XParse WavyLine
parseWavyLine :: XParse WavyLine
parseWavyLine = 
      StartStopContinue
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> WavyLine
WavyLine
        (StartStopContinue
 -> Maybe NumberLevel
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe AboveBelow
 -> Maybe Color
 -> Maybe StartNote
 -> Maybe TrillStep
 -> Maybe TwoNoteTurn
 -> Maybe YesNo
 -> Maybe TrillBeats
 -> Maybe Percent
 -> Maybe Percent
 -> WavyLine)
-> XParse StartStopContinue
-> XParse
     (Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String
-> (String -> XParse StartStopContinue) -> XParse StartStopContinue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartStopContinue
parseStartStopContinue)
        XParse
  (Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe AboveBelow
      -> Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe AboveBelow
   -> Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe AboveBelow)
-> XParse
     (Maybe Color
      -> Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AboveBelow -> XParse (Maybe AboveBelow)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"placement") XParse String -> (String -> XParse AboveBelow) -> XParse AboveBelow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse AboveBelow
parseAboveBelow)
        XParse
  (Maybe Color
   -> Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe Color)
-> XParse
     (Maybe StartNote
      -> Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse
  (Maybe StartNote
   -> Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe StartNote)
-> XParse
     (Maybe TrillStep
      -> Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StartNote -> XParse (Maybe StartNote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"start-note") XParse String -> (String -> XParse StartNote) -> XParse StartNote
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StartNote
parseStartNote)
        XParse
  (Maybe TrillStep
   -> Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe TrillStep)
-> XParse
     (Maybe TwoNoteTurn
      -> Maybe YesNo
      -> Maybe TrillBeats
      -> Maybe Percent
      -> Maybe Percent
      -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillStep -> XParse (Maybe TrillStep)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"trill-step") XParse String -> (String -> XParse TrillStep) -> XParse TrillStep
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillStep
parseTrillStep)
        XParse
  (Maybe TwoNoteTurn
   -> Maybe YesNo
   -> Maybe TrillBeats
   -> Maybe Percent
   -> Maybe Percent
   -> WavyLine)
-> XParse (Maybe TwoNoteTurn)
-> XParse
     (Maybe YesNo
      -> Maybe TrillBeats -> Maybe Percent -> Maybe Percent -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TwoNoteTurn -> XParse (Maybe TwoNoteTurn)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"two-note-turn") XParse String
-> (String -> XParse TwoNoteTurn) -> XParse TwoNoteTurn
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TwoNoteTurn
parseTwoNoteTurn)
        XParse
  (Maybe YesNo
   -> Maybe TrillBeats -> Maybe Percent -> Maybe Percent -> WavyLine)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe TrillBeats -> Maybe Percent -> Maybe Percent -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"accelerate") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe TrillBeats -> Maybe Percent -> Maybe Percent -> WavyLine)
-> XParse (Maybe TrillBeats)
-> XParse (Maybe Percent -> Maybe Percent -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse TrillBeats -> XParse (Maybe TrillBeats)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"beats") XParse String -> (String -> XParse TrillBeats) -> XParse TrillBeats
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse TrillBeats
parseTrillBeats)
        XParse (Maybe Percent -> Maybe Percent -> WavyLine)
-> XParse (Maybe Percent) -> XParse (Maybe Percent -> WavyLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"second-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)
        XParse (Maybe Percent -> WavyLine)
-> XParse (Maybe Percent) -> XParse WavyLine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Percent -> XParse (Maybe Percent)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"last-beat") XParse String -> (String -> XParse Percent) -> XParse Percent
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Percent
parsePercent)

-- | Smart constructor for 'WavyLine'
mkWavyLine :: StartStopContinue -> WavyLine
mkWavyLine :: StartStopContinue -> WavyLine
mkWavyLine StartStopContinue
a = StartStopContinue
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe AboveBelow
-> Maybe Color
-> Maybe StartNote
-> Maybe TrillStep
-> Maybe TwoNoteTurn
-> Maybe YesNo
-> Maybe TrillBeats
-> Maybe Percent
-> Maybe Percent
-> WavyLine
WavyLine StartStopContinue
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe AboveBelow
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe StartNote
forall a. Maybe a
Nothing Maybe TrillStep
forall a. Maybe a
Nothing Maybe TwoNoteTurn
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe TrillBeats
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing Maybe Percent
forall a. Maybe a
Nothing

-- | @wedge@ /(complex)/
--
-- The wedge type represents crescendo and diminuendo wedge symbols. The type attribute is crescendo for the start of a wedge that is closed at the left side, and diminuendo for the start of a wedge that is closed on the right side. Spread values are measured in tenths; those at the start of a crescendo wedge or end of a diminuendo wedge are ignored. The niente attribute is yes if a circle appears at the point of the wedge, indicating a crescendo from nothing or diminuendo to nothing. It is no by default, and used only when the type is crescendo, or the type is stop for a wedge that began with a diminuendo type. The line-type is solid by default.
data Wedge = 
      Wedge {
          Wedge -> WedgeType
wedgeType :: WedgeType -- ^ /type/ attribute
        , Wedge -> Maybe NumberLevel
wedgeNumber :: (Maybe NumberLevel) -- ^ /number/ attribute
        , Wedge -> Maybe Tenths
wedgeSpread :: (Maybe Tenths) -- ^ /spread/ attribute
        , Wedge -> Maybe YesNo
wedgeNiente :: (Maybe YesNo) -- ^ /niente/ attribute
        , Wedge -> Maybe LineType
wedgeLineType :: (Maybe LineType) -- ^ /line-type/ attribute
        , Wedge -> Maybe Tenths
wedgeDashLength :: (Maybe Tenths) -- ^ /dash-length/ attribute
        , Wedge -> Maybe Tenths
wedgeSpaceLength :: (Maybe Tenths) -- ^ /space-length/ attribute
        , Wedge -> Maybe Tenths
wedgeDefaultX :: (Maybe Tenths) -- ^ /default-x/ attribute
        , Wedge -> Maybe Tenths
wedgeDefaultY :: (Maybe Tenths) -- ^ /default-y/ attribute
        , Wedge -> Maybe Tenths
wedgeRelativeX :: (Maybe Tenths) -- ^ /relative-x/ attribute
        , Wedge -> Maybe Tenths
wedgeRelativeY :: (Maybe Tenths) -- ^ /relative-y/ attribute
        , Wedge -> Maybe Color
wedgeColor :: (Maybe Color) -- ^ /color/ attribute
        , Wedge -> Maybe ID
wedgeId :: (Maybe ID) -- ^ /id/ attribute
       }
    deriving (Wedge -> Wedge -> Bool
(Wedge -> Wedge -> Bool) -> (Wedge -> Wedge -> Bool) -> Eq Wedge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wedge -> Wedge -> Bool
$c/= :: Wedge -> Wedge -> Bool
== :: Wedge -> Wedge -> Bool
$c== :: Wedge -> Wedge -> Bool
Eq,Typeable,(forall x. Wedge -> Rep Wedge x)
-> (forall x. Rep Wedge x -> Wedge) -> Generic Wedge
forall x. Rep Wedge x -> Wedge
forall x. Wedge -> Rep Wedge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wedge x -> Wedge
$cfrom :: forall x. Wedge -> Rep Wedge x
Generic,Int -> Wedge -> ShowS
[Wedge] -> ShowS
Wedge -> String
(Int -> Wedge -> ShowS)
-> (Wedge -> String) -> ([Wedge] -> ShowS) -> Show Wedge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wedge] -> ShowS
$cshowList :: [Wedge] -> ShowS
show :: Wedge -> String
$cshow :: Wedge -> String
showsPrec :: Int -> Wedge -> ShowS
$cshowsPrec :: Int -> Wedge -> ShowS
Show)
instance EmitXml Wedge where
    emitXml :: Wedge -> XmlRep
emitXml (Wedge WedgeType
a Maybe NumberLevel
b Maybe Tenths
c Maybe YesNo
d Maybe LineType
e Maybe Tenths
f Maybe Tenths
g Maybe Tenths
h Maybe Tenths
i Maybe Tenths
j Maybe Tenths
k Maybe Color
l Maybe ID
m) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        ([QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"type" Maybe String
forall a. Maybe a
Nothing) (WedgeType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml WedgeType
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (NumberLevel -> XmlRep) -> Maybe NumberLevel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (NumberLevel -> XmlRep) -> NumberLevel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.NumberLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe NumberLevel
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"spread" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (YesNo -> XmlRep) -> Maybe YesNo -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"niente" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (YesNo -> XmlRep) -> YesNo -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.YesNo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe YesNo
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (LineType -> XmlRep) -> Maybe LineType -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"line-type" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (LineType -> XmlRep) -> LineType -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineType -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe LineType
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"dash-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
f] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"space-length" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
g] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
h] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"default-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
i] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-x" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
j] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Tenths -> XmlRep) -> Maybe Tenths -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"relative-y" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tenths -> XmlRep) -> Tenths -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Tenths
k] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Color -> XmlRep) -> Maybe Color -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"color" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Color -> XmlRep) -> Color -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Color -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Color
l] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ID -> XmlRep) -> Maybe ID -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XAttr (String -> Maybe String -> QN
QN String
"id" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (ID -> XmlRep) -> ID -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ID -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ID
m])
        []
parseWedge :: P.XParse Wedge
parseWedge :: XParse Wedge
parseWedge = 
      WedgeType
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe YesNo
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Wedge
Wedge
        (WedgeType
 -> Maybe NumberLevel
 -> Maybe Tenths
 -> Maybe YesNo
 -> Maybe LineType
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Tenths
 -> Maybe Color
 -> Maybe ID
 -> Wedge)
-> XParse WedgeType
-> XParse
     (Maybe NumberLevel
      -> Maybe Tenths
      -> Maybe YesNo
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String
P.xattr (String -> QName
P.name String
"type") XParse String -> (String -> XParse WedgeType) -> XParse WedgeType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse WedgeType
parseWedgeType)
        XParse
  (Maybe NumberLevel
   -> Maybe Tenths
   -> Maybe YesNo
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe NumberLevel)
-> XParse
     (Maybe Tenths
      -> Maybe YesNo
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse NumberLevel -> XParse (Maybe NumberLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"number") XParse String
-> (String -> XParse NumberLevel) -> XParse NumberLevel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NumberLevel
parseNumberLevel)
        XParse
  (Maybe Tenths
   -> Maybe YesNo
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe YesNo
      -> Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"spread") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe YesNo
   -> Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe YesNo)
-> XParse
     (Maybe LineType
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse YesNo -> XParse (Maybe YesNo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"niente") XParse String -> (String -> XParse YesNo) -> XParse YesNo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YesNo
parseYesNo)
        XParse
  (Maybe LineType
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe LineType)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse LineType -> XParse (Maybe LineType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"line-type") XParse String -> (String -> XParse LineType) -> XParse LineType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse LineType
parseLineType)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"dash-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"space-length") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths
      -> Maybe Tenths
      -> Maybe Tenths
      -> Maybe Color
      -> Maybe ID
      -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths
   -> Maybe Tenths
   -> Maybe Tenths
   -> Maybe Color
   -> Maybe ID
   -> Wedge)
-> XParse (Maybe Tenths)
-> XParse
     (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Maybe ID -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"default-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse
  (Maybe Tenths -> Maybe Tenths -> Maybe Color -> Maybe ID -> Wedge)
-> XParse (Maybe Tenths)
-> XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-x") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Tenths -> Maybe Color -> Maybe ID -> Wedge)
-> XParse (Maybe Tenths)
-> XParse (Maybe Color -> Maybe ID -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tenths -> XParse (Maybe Tenths)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"relative-y") XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths)
        XParse (Maybe Color -> Maybe ID -> Wedge)
-> XParse (Maybe Color) -> XParse (Maybe ID -> Wedge)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Color -> XParse (Maybe Color)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"color") XParse String -> (String -> XParse Color) -> XParse Color
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Color
parseColor)
        XParse (Maybe ID -> Wedge) -> XParse (Maybe ID) -> XParse Wedge
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ID -> XParse (Maybe ID)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String
P.xattr (String -> QName
P.name String
"id") XParse String -> (String -> XParse ID) -> XParse ID
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ID
parseID)

-- | Smart constructor for 'Wedge'
mkWedge :: WedgeType -> Wedge
mkWedge :: WedgeType -> Wedge
mkWedge WedgeType
a = WedgeType
-> Maybe NumberLevel
-> Maybe Tenths
-> Maybe YesNo
-> Maybe LineType
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Tenths
-> Maybe Color
-> Maybe ID
-> Wedge
Wedge WedgeType
a Maybe NumberLevel
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe YesNo
forall a. Maybe a
Nothing Maybe LineType
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Tenths
forall a. Maybe a
Nothing Maybe Color
forall a. Maybe a
Nothing Maybe ID
forall a. Maybe a
Nothing

-- | @work@ /(complex)/
--
-- Works are optionally identified by number and title. The work type also may indicate a link to the opus document that composes multiple scores into a collection.
data Work = 
      Work {
          Work -> Maybe String
workWorkNumber :: (Maybe String) -- ^ /work-number/ child element
        , Work -> Maybe String
workWorkTitle :: (Maybe String) -- ^ /work-title/ child element
        , Work -> Maybe Opus
workOpus :: (Maybe Opus) -- ^ /opus/ child element
       }
    deriving (Work -> Work -> Bool
(Work -> Work -> Bool) -> (Work -> Work -> Bool) -> Eq Work
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Work -> Work -> Bool
$c/= :: Work -> Work -> Bool
== :: Work -> Work -> Bool
$c== :: Work -> Work -> Bool
Eq,Typeable,(forall x. Work -> Rep Work x)
-> (forall x. Rep Work x -> Work) -> Generic Work
forall x. Rep Work x -> Work
forall x. Work -> Rep Work x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Work x -> Work
$cfrom :: forall x. Work -> Rep Work x
Generic,Int -> Work -> ShowS
[Work] -> ShowS
Work -> String
(Int -> Work -> ShowS)
-> (Work -> String) -> ([Work] -> ShowS) -> Show Work
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Work] -> ShowS
$cshowList :: [Work] -> ShowS
show :: Work -> String
$cshow :: Work -> String
showsPrec :: Int -> Work -> ShowS
$cshowsPrec :: Int -> Work -> ShowS
Show)
instance EmitXml Work where
    emitXml :: Work -> XmlRep
emitXml (Work Maybe String
a Maybe String
b Maybe Opus
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"work-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"work-title" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Opus -> XmlRep) -> Maybe Opus -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"opus" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Opus -> XmlRep) -> Opus -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Opus -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Opus
c])
parseWork :: P.XParse Work
parseWork :: XParse Work
parseWork = 
      Maybe String -> Maybe String -> Maybe Opus -> Work
Work
        (Maybe String -> Maybe String -> Maybe Opus -> Work)
-> XParse (Maybe String)
-> XParse (Maybe String -> Maybe Opus -> Work)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"work-number") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse (Maybe String -> Maybe Opus -> Work)
-> XParse (Maybe String) -> XParse (Maybe Opus -> Work)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"work-title") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse (Maybe Opus -> Work) -> XParse (Maybe Opus) -> XParse Work
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Opus -> XParse (Maybe Opus)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Opus -> XParse Opus
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"opus") (XParse Opus
parseOpus))

-- | Smart constructor for 'Work'
mkWork :: Work
mkWork :: Work
mkWork = Maybe String -> Maybe String -> Maybe Opus -> Work
Work Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Opus
forall a. Maybe a
Nothing

-- | @arrow@ /(choice)/
data ChxArrow = 
      ArrowArrowDirection {
          ChxArrow -> ArrowDirection
arrowArrowDirection :: ArrowDirection -- ^ /arrow-direction/ child element
        , ChxArrow -> Maybe ArrowStyle
arrowArrowStyle :: (Maybe ArrowStyle) -- ^ /arrow-style/ child element
        , ChxArrow -> Maybe Empty
arrowArrowhead :: (Maybe Empty) -- ^ /arrowhead/ child element
       }
    | ArrowCircularArrow {
          ChxArrow -> CircularArrow
arrowCircularArrow :: CircularArrow -- ^ /circular-arrow/ child element
       }
    deriving (ChxArrow -> ChxArrow -> Bool
(ChxArrow -> ChxArrow -> Bool)
-> (ChxArrow -> ChxArrow -> Bool) -> Eq ChxArrow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxArrow -> ChxArrow -> Bool
$c/= :: ChxArrow -> ChxArrow -> Bool
== :: ChxArrow -> ChxArrow -> Bool
$c== :: ChxArrow -> ChxArrow -> Bool
Eq,Typeable,(forall x. ChxArrow -> Rep ChxArrow x)
-> (forall x. Rep ChxArrow x -> ChxArrow) -> Generic ChxArrow
forall x. Rep ChxArrow x -> ChxArrow
forall x. ChxArrow -> Rep ChxArrow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxArrow x -> ChxArrow
$cfrom :: forall x. ChxArrow -> Rep ChxArrow x
Generic,Int -> ChxArrow -> ShowS
[ChxArrow] -> ShowS
ChxArrow -> String
(Int -> ChxArrow -> ShowS)
-> (ChxArrow -> String) -> ([ChxArrow] -> ShowS) -> Show ChxArrow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxArrow] -> ShowS
$cshowList :: [ChxArrow] -> ShowS
show :: ChxArrow -> String
$cshow :: ChxArrow -> String
showsPrec :: Int -> ChxArrow -> ShowS
$cshowsPrec :: Int -> ChxArrow -> ShowS
Show)
instance EmitXml ChxArrow where
    emitXml :: ChxArrow -> XmlRep
emitXml (ArrowArrowDirection ArrowDirection
a Maybe ArrowStyle
b Maybe Empty
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"arrow-direction" Maybe String
forall a. Maybe a
Nothing) (ArrowDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ArrowDirection
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (ArrowStyle -> XmlRep) -> Maybe ArrowStyle -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"arrow-style" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (ArrowStyle -> XmlRep) -> ArrowStyle -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ArrowStyle -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe ArrowStyle
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"arrowhead" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
c])
    emitXml (ArrowCircularArrow CircularArrow
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"circular-arrow" Maybe String
forall a. Maybe a
Nothing) (CircularArrow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CircularArrow
a)])
parseChxArrow :: P.XParse ChxArrow
parseChxArrow :: XParse ChxArrow
parseChxArrow = 
      ArrowDirection -> Maybe ArrowStyle -> Maybe Empty -> ChxArrow
ArrowArrowDirection
        (ArrowDirection -> Maybe ArrowStyle -> Maybe Empty -> ChxArrow)
-> XParse ArrowDirection
-> XParse (Maybe ArrowStyle -> Maybe Empty -> ChxArrow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse ArrowDirection -> XParse ArrowDirection
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"arrow-direction") (XParse String
P.xtext XParse String
-> (String -> XParse ArrowDirection) -> XParse ArrowDirection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ArrowDirection
parseArrowDirection))
        XParse (Maybe ArrowStyle -> Maybe Empty -> ChxArrow)
-> XParse (Maybe ArrowStyle) -> XParse (Maybe Empty -> ChxArrow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ArrowStyle -> XParse (Maybe ArrowStyle)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse ArrowStyle -> XParse ArrowStyle
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"arrow-style") (XParse String
P.xtext XParse String -> (String -> XParse ArrowStyle) -> XParse ArrowStyle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse ArrowStyle
parseArrowStyle))
        XParse (Maybe Empty -> ChxArrow)
-> XParse (Maybe Empty) -> XParse ChxArrow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"arrowhead") (XParse Empty
parseEmpty))
      XParse ChxArrow -> XParse ChxArrow -> XParse ChxArrow
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CircularArrow -> ChxArrow
ArrowCircularArrow
        (CircularArrow -> ChxArrow)
-> XParse CircularArrow -> XParse ChxArrow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse CircularArrow -> XParse CircularArrow
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"circular-arrow") (XParse String
P.xtext XParse String
-> (String -> XParse CircularArrow) -> XParse CircularArrow
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse CircularArrow
parseCircularArrow))

-- | Smart constructor for 'ArrowArrowDirection'
mkArrowArrowDirection :: ArrowDirection -> ChxArrow
mkArrowArrowDirection :: ArrowDirection -> ChxArrow
mkArrowArrowDirection ArrowDirection
a = ArrowDirection -> Maybe ArrowStyle -> Maybe Empty -> ChxArrow
ArrowArrowDirection ArrowDirection
a Maybe ArrowStyle
forall a. Maybe a
Nothing Maybe Empty
forall a. Maybe a
Nothing
-- | Smart constructor for 'ArrowCircularArrow'
mkArrowCircularArrow :: CircularArrow -> ChxArrow
mkArrowCircularArrow :: CircularArrow -> ChxArrow
mkArrowCircularArrow CircularArrow
a = CircularArrow -> ChxArrow
ArrowCircularArrow CircularArrow
a

-- | @articulations@ /(choice)/
data ChxArticulations = 
      ArticulationsAccent {
          ChxArticulations -> EmptyPlacement
articulationsAccent :: EmptyPlacement -- ^ /accent/ child element
       }
    | ArticulationsStrongAccent {
          ChxArticulations -> StrongAccent
articulationsStrongAccent :: StrongAccent -- ^ /strong-accent/ child element
       }
    | ArticulationsStaccato {
          ChxArticulations -> EmptyPlacement
articulationsStaccato :: EmptyPlacement -- ^ /staccato/ child element
       }
    | ArticulationsTenuto {
          ChxArticulations -> EmptyPlacement
articulationsTenuto :: EmptyPlacement -- ^ /tenuto/ child element
       }
    | ArticulationsDetachedLegato {
          ChxArticulations -> EmptyPlacement
articulationsDetachedLegato :: EmptyPlacement -- ^ /detached-legato/ child element
       }
    | ArticulationsStaccatissimo {
          ChxArticulations -> EmptyPlacement
articulationsStaccatissimo :: EmptyPlacement -- ^ /staccatissimo/ child element
       }
    | ArticulationsSpiccato {
          ChxArticulations -> EmptyPlacement
articulationsSpiccato :: EmptyPlacement -- ^ /spiccato/ child element
       }
    | ArticulationsScoop {
          ChxArticulations -> EmptyLine
articulationsScoop :: EmptyLine -- ^ /scoop/ child element
       }
    | ArticulationsPlop {
          ChxArticulations -> EmptyLine
articulationsPlop :: EmptyLine -- ^ /plop/ child element
       }
    | ArticulationsDoit {
          ChxArticulations -> EmptyLine
articulationsDoit :: EmptyLine -- ^ /doit/ child element
       }
    | ArticulationsFalloff {
          ChxArticulations -> EmptyLine
articulationsFalloff :: EmptyLine -- ^ /falloff/ child element
       }
    | ArticulationsBreathMark {
          ChxArticulations -> BreathMark
articulationsBreathMark :: BreathMark -- ^ /breath-mark/ child element
       }
    | ArticulationsCaesura {
          ChxArticulations -> Caesura
articulationsCaesura :: Caesura -- ^ /caesura/ child element
       }
    | ArticulationsStress {
          ChxArticulations -> EmptyPlacement
articulationsStress :: EmptyPlacement -- ^ /stress/ child element
       }
    | ArticulationsUnstress {
          ChxArticulations -> EmptyPlacement
articulationsUnstress :: EmptyPlacement -- ^ /unstress/ child element
       }
    | ArticulationsSoftAccent {
          ChxArticulations -> EmptyPlacement
articulationsSoftAccent :: EmptyPlacement -- ^ /soft-accent/ child element
       }
    | ArticulationsOtherArticulation {
          ChxArticulations -> OtherPlacementText
articulationsOtherArticulation :: OtherPlacementText -- ^ /other-articulation/ child element
       }
    deriving (ChxArticulations -> ChxArticulations -> Bool
(ChxArticulations -> ChxArticulations -> Bool)
-> (ChxArticulations -> ChxArticulations -> Bool)
-> Eq ChxArticulations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxArticulations -> ChxArticulations -> Bool
$c/= :: ChxArticulations -> ChxArticulations -> Bool
== :: ChxArticulations -> ChxArticulations -> Bool
$c== :: ChxArticulations -> ChxArticulations -> Bool
Eq,Typeable,(forall x. ChxArticulations -> Rep ChxArticulations x)
-> (forall x. Rep ChxArticulations x -> ChxArticulations)
-> Generic ChxArticulations
forall x. Rep ChxArticulations x -> ChxArticulations
forall x. ChxArticulations -> Rep ChxArticulations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxArticulations x -> ChxArticulations
$cfrom :: forall x. ChxArticulations -> Rep ChxArticulations x
Generic,Int -> ChxArticulations -> ShowS
[ChxArticulations] -> ShowS
ChxArticulations -> String
(Int -> ChxArticulations -> ShowS)
-> (ChxArticulations -> String)
-> ([ChxArticulations] -> ShowS)
-> Show ChxArticulations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxArticulations] -> ShowS
$cshowList :: [ChxArticulations] -> ShowS
show :: ChxArticulations -> String
$cshow :: ChxArticulations -> String
showsPrec :: Int -> ChxArticulations -> ShowS
$cshowsPrec :: Int -> ChxArticulations -> ShowS
Show)
instance EmitXml ChxArticulations where
    emitXml :: ChxArticulations -> XmlRep
emitXml (ArticulationsAccent EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accent" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsStrongAccent StrongAccent
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"strong-accent" Maybe String
forall a. Maybe a
Nothing) (StrongAccent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StrongAccent
a)])
    emitXml (ArticulationsStaccato EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staccato" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsTenuto EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tenuto" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsDetachedLegato EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"detached-legato" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsStaccatissimo EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staccatissimo" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsSpiccato EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"spiccato" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsScoop EmptyLine
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"scoop" Maybe String
forall a. Maybe a
Nothing) (EmptyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyLine
a)])
    emitXml (ArticulationsPlop EmptyLine
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"plop" Maybe String
forall a. Maybe a
Nothing) (EmptyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyLine
a)])
    emitXml (ArticulationsDoit EmptyLine
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"doit" Maybe String
forall a. Maybe a
Nothing) (EmptyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyLine
a)])
    emitXml (ArticulationsFalloff EmptyLine
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"falloff" Maybe String
forall a. Maybe a
Nothing) (EmptyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyLine
a)])
    emitXml (ArticulationsBreathMark BreathMark
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"breath-mark" Maybe String
forall a. Maybe a
Nothing) (BreathMark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BreathMark
a)])
    emitXml (ArticulationsCaesura Caesura
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"caesura" Maybe String
forall a. Maybe a
Nothing) (Caesura -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Caesura
a)])
    emitXml (ArticulationsStress EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stress" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsUnstress EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"unstress" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsSoftAccent EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"soft-accent" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (ArticulationsOtherArticulation OtherPlacementText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-articulation" Maybe String
forall a. Maybe a
Nothing) (OtherPlacementText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherPlacementText
a)])
parseChxArticulations :: P.XParse ChxArticulations
parseChxArticulations :: XParse ChxArticulations
parseChxArticulations = 
      EmptyPlacement -> ChxArticulations
ArticulationsAccent
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accent") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StrongAccent -> ChxArticulations
ArticulationsStrongAccent
        (StrongAccent -> ChxArticulations)
-> XParse StrongAccent -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse StrongAccent -> XParse StrongAccent
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"strong-accent") (XParse StrongAccent
parseStrongAccent))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsStaccato
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staccato") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsTenuto
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tenuto") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsDetachedLegato
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"detached-legato") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsStaccatissimo
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staccatissimo") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsSpiccato
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"spiccato") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyLine -> ChxArticulations
ArticulationsScoop
        (EmptyLine -> ChxArticulations)
-> XParse EmptyLine -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyLine -> XParse EmptyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"scoop") (XParse EmptyLine
parseEmptyLine))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyLine -> ChxArticulations
ArticulationsPlop
        (EmptyLine -> ChxArticulations)
-> XParse EmptyLine -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyLine -> XParse EmptyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"plop") (XParse EmptyLine
parseEmptyLine))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyLine -> ChxArticulations
ArticulationsDoit
        (EmptyLine -> ChxArticulations)
-> XParse EmptyLine -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyLine -> XParse EmptyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"doit") (XParse EmptyLine
parseEmptyLine))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyLine -> ChxArticulations
ArticulationsFalloff
        (EmptyLine -> ChxArticulations)
-> XParse EmptyLine -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyLine -> XParse EmptyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"falloff") (XParse EmptyLine
parseEmptyLine))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BreathMark -> ChxArticulations
ArticulationsBreathMark
        (BreathMark -> ChxArticulations)
-> XParse BreathMark -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse BreathMark -> XParse BreathMark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"breath-mark") (XParse BreathMark
parseBreathMark))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Caesura -> ChxArticulations
ArticulationsCaesura
        (Caesura -> ChxArticulations)
-> XParse Caesura -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Caesura -> XParse Caesura
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"caesura") (XParse Caesura
parseCaesura))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsStress
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stress") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsUnstress
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"unstress") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxArticulations
ArticulationsSoftAccent
        (EmptyPlacement -> ChxArticulations)
-> XParse EmptyPlacement -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"soft-accent") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxArticulations
-> XParse ChxArticulations -> XParse ChxArticulations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherPlacementText -> ChxArticulations
ArticulationsOtherArticulation
        (OtherPlacementText -> ChxArticulations)
-> XParse OtherPlacementText -> XParse ChxArticulations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherPlacementText -> XParse OtherPlacementText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-articulation") (XParse OtherPlacementText
parseOtherPlacementText))

-- | Smart constructor for 'ArticulationsAccent'
mkArticulationsAccent :: EmptyPlacement -> ChxArticulations
mkArticulationsAccent :: EmptyPlacement -> ChxArticulations
mkArticulationsAccent EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsAccent EmptyPlacement
a
-- | Smart constructor for 'ArticulationsStrongAccent'
mkArticulationsStrongAccent :: StrongAccent -> ChxArticulations
mkArticulationsStrongAccent :: StrongAccent -> ChxArticulations
mkArticulationsStrongAccent StrongAccent
a = StrongAccent -> ChxArticulations
ArticulationsStrongAccent StrongAccent
a
-- | Smart constructor for 'ArticulationsStaccato'
mkArticulationsStaccato :: EmptyPlacement -> ChxArticulations
mkArticulationsStaccato :: EmptyPlacement -> ChxArticulations
mkArticulationsStaccato EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsStaccato EmptyPlacement
a
-- | Smart constructor for 'ArticulationsTenuto'
mkArticulationsTenuto :: EmptyPlacement -> ChxArticulations
mkArticulationsTenuto :: EmptyPlacement -> ChxArticulations
mkArticulationsTenuto EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsTenuto EmptyPlacement
a
-- | Smart constructor for 'ArticulationsDetachedLegato'
mkArticulationsDetachedLegato :: EmptyPlacement -> ChxArticulations
mkArticulationsDetachedLegato :: EmptyPlacement -> ChxArticulations
mkArticulationsDetachedLegato EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsDetachedLegato EmptyPlacement
a
-- | Smart constructor for 'ArticulationsStaccatissimo'
mkArticulationsStaccatissimo :: EmptyPlacement -> ChxArticulations
mkArticulationsStaccatissimo :: EmptyPlacement -> ChxArticulations
mkArticulationsStaccatissimo EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsStaccatissimo EmptyPlacement
a
-- | Smart constructor for 'ArticulationsSpiccato'
mkArticulationsSpiccato :: EmptyPlacement -> ChxArticulations
mkArticulationsSpiccato :: EmptyPlacement -> ChxArticulations
mkArticulationsSpiccato EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsSpiccato EmptyPlacement
a
-- | Smart constructor for 'ArticulationsScoop'
mkArticulationsScoop :: EmptyLine -> ChxArticulations
mkArticulationsScoop :: EmptyLine -> ChxArticulations
mkArticulationsScoop EmptyLine
a = EmptyLine -> ChxArticulations
ArticulationsScoop EmptyLine
a
-- | Smart constructor for 'ArticulationsPlop'
mkArticulationsPlop :: EmptyLine -> ChxArticulations
mkArticulationsPlop :: EmptyLine -> ChxArticulations
mkArticulationsPlop EmptyLine
a = EmptyLine -> ChxArticulations
ArticulationsPlop EmptyLine
a
-- | Smart constructor for 'ArticulationsDoit'
mkArticulationsDoit :: EmptyLine -> ChxArticulations
mkArticulationsDoit :: EmptyLine -> ChxArticulations
mkArticulationsDoit EmptyLine
a = EmptyLine -> ChxArticulations
ArticulationsDoit EmptyLine
a
-- | Smart constructor for 'ArticulationsFalloff'
mkArticulationsFalloff :: EmptyLine -> ChxArticulations
mkArticulationsFalloff :: EmptyLine -> ChxArticulations
mkArticulationsFalloff EmptyLine
a = EmptyLine -> ChxArticulations
ArticulationsFalloff EmptyLine
a
-- | Smart constructor for 'ArticulationsBreathMark'
mkArticulationsBreathMark :: BreathMark -> ChxArticulations
mkArticulationsBreathMark :: BreathMark -> ChxArticulations
mkArticulationsBreathMark BreathMark
a = BreathMark -> ChxArticulations
ArticulationsBreathMark BreathMark
a
-- | Smart constructor for 'ArticulationsCaesura'
mkArticulationsCaesura :: Caesura -> ChxArticulations
mkArticulationsCaesura :: Caesura -> ChxArticulations
mkArticulationsCaesura Caesura
a = Caesura -> ChxArticulations
ArticulationsCaesura Caesura
a
-- | Smart constructor for 'ArticulationsStress'
mkArticulationsStress :: EmptyPlacement -> ChxArticulations
mkArticulationsStress :: EmptyPlacement -> ChxArticulations
mkArticulationsStress EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsStress EmptyPlacement
a
-- | Smart constructor for 'ArticulationsUnstress'
mkArticulationsUnstress :: EmptyPlacement -> ChxArticulations
mkArticulationsUnstress :: EmptyPlacement -> ChxArticulations
mkArticulationsUnstress EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsUnstress EmptyPlacement
a
-- | Smart constructor for 'ArticulationsSoftAccent'
mkArticulationsSoftAccent :: EmptyPlacement -> ChxArticulations
mkArticulationsSoftAccent :: EmptyPlacement -> ChxArticulations
mkArticulationsSoftAccent EmptyPlacement
a = EmptyPlacement -> ChxArticulations
ArticulationsSoftAccent EmptyPlacement
a
-- | Smart constructor for 'ArticulationsOtherArticulation'
mkArticulationsOtherArticulation :: OtherPlacementText -> ChxArticulations
mkArticulationsOtherArticulation :: OtherPlacementText -> ChxArticulations
mkArticulationsOtherArticulation OtherPlacementText
a = OtherPlacementText -> ChxArticulations
ArticulationsOtherArticulation OtherPlacementText
a

-- | @bend@ /(choice)/
data ChxBend = 
      BendPreBend {
          ChxBend -> Empty
bendPreBend :: Empty -- ^ /pre-bend/ child element
       }
    | BendRelease {
          ChxBend -> Empty
bendRelease :: Empty -- ^ /release/ child element
       }
    deriving (ChxBend -> ChxBend -> Bool
(ChxBend -> ChxBend -> Bool)
-> (ChxBend -> ChxBend -> Bool) -> Eq ChxBend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxBend -> ChxBend -> Bool
$c/= :: ChxBend -> ChxBend -> Bool
== :: ChxBend -> ChxBend -> Bool
$c== :: ChxBend -> ChxBend -> Bool
Eq,Typeable,(forall x. ChxBend -> Rep ChxBend x)
-> (forall x. Rep ChxBend x -> ChxBend) -> Generic ChxBend
forall x. Rep ChxBend x -> ChxBend
forall x. ChxBend -> Rep ChxBend x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxBend x -> ChxBend
$cfrom :: forall x. ChxBend -> Rep ChxBend x
Generic,Int -> ChxBend -> ShowS
[ChxBend] -> ShowS
ChxBend -> String
(Int -> ChxBend -> ShowS)
-> (ChxBend -> String) -> ([ChxBend] -> ShowS) -> Show ChxBend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxBend] -> ShowS
$cshowList :: [ChxBend] -> ShowS
show :: ChxBend -> String
$cshow :: ChxBend -> String
showsPrec :: Int -> ChxBend -> ShowS
$cshowsPrec :: Int -> ChxBend -> ShowS
Show)
instance EmitXml ChxBend where
    emitXml :: ChxBend -> XmlRep
emitXml (BendPreBend Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pre-bend" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (BendRelease Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"release" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
parseChxBend :: P.XParse ChxBend
parseChxBend :: XParse ChxBend
parseChxBend = 
      Empty -> ChxBend
BendPreBend
        (Empty -> ChxBend) -> XParse Empty -> XParse ChxBend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pre-bend") (XParse Empty
parseEmpty))
      XParse ChxBend -> XParse ChxBend -> XParse ChxBend
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxBend
BendRelease
        (Empty -> ChxBend) -> XParse Empty -> XParse ChxBend
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"release") (XParse Empty
parseEmpty))

-- | Smart constructor for 'BendPreBend'
mkBendPreBend :: Empty -> ChxBend
mkBendPreBend :: Empty -> ChxBend
mkBendPreBend Empty
a = Empty -> ChxBend
BendPreBend Empty
a
-- | Smart constructor for 'BendRelease'
mkBendRelease :: Empty -> ChxBend
mkBendRelease :: Empty -> ChxBend
mkBendRelease Empty
a = Empty -> ChxBend
BendRelease Empty
a

-- | @credit@ /(choice)/
data ChxCredit0 = 
      CreditCreditWords {
          ChxCredit0 -> FormattedTextId
creditCreditWords :: FormattedTextId -- ^ /credit-words/ child element
       }
    | CreditCreditSymbol {
          ChxCredit0 -> FormattedSymbolId
creditCreditSymbol :: FormattedSymbolId -- ^ /credit-symbol/ child element
       }
    deriving (ChxCredit0 -> ChxCredit0 -> Bool
(ChxCredit0 -> ChxCredit0 -> Bool)
-> (ChxCredit0 -> ChxCredit0 -> Bool) -> Eq ChxCredit0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxCredit0 -> ChxCredit0 -> Bool
$c/= :: ChxCredit0 -> ChxCredit0 -> Bool
== :: ChxCredit0 -> ChxCredit0 -> Bool
$c== :: ChxCredit0 -> ChxCredit0 -> Bool
Eq,Typeable,(forall x. ChxCredit0 -> Rep ChxCredit0 x)
-> (forall x. Rep ChxCredit0 x -> ChxCredit0) -> Generic ChxCredit0
forall x. Rep ChxCredit0 x -> ChxCredit0
forall x. ChxCredit0 -> Rep ChxCredit0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxCredit0 x -> ChxCredit0
$cfrom :: forall x. ChxCredit0 -> Rep ChxCredit0 x
Generic,Int -> ChxCredit0 -> ShowS
[ChxCredit0] -> ShowS
ChxCredit0 -> String
(Int -> ChxCredit0 -> ShowS)
-> (ChxCredit0 -> String)
-> ([ChxCredit0] -> ShowS)
-> Show ChxCredit0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxCredit0] -> ShowS
$cshowList :: [ChxCredit0] -> ShowS
show :: ChxCredit0 -> String
$cshow :: ChxCredit0 -> String
showsPrec :: Int -> ChxCredit0 -> ShowS
$cshowsPrec :: Int -> ChxCredit0 -> ShowS
Show)
instance EmitXml ChxCredit0 where
    emitXml :: ChxCredit0 -> XmlRep
emitXml (CreditCreditWords FormattedTextId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-words" Maybe String
forall a. Maybe a
Nothing) (FormattedTextId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedTextId
a)])
    emitXml (CreditCreditSymbol FormattedSymbolId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-symbol" Maybe String
forall a. Maybe a
Nothing) (FormattedSymbolId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedSymbolId
a)])
parseChxCredit0 :: P.XParse ChxCredit0
parseChxCredit0 :: XParse ChxCredit0
parseChxCredit0 = 
      FormattedTextId -> ChxCredit0
CreditCreditWords
        (FormattedTextId -> ChxCredit0)
-> XParse FormattedTextId -> XParse ChxCredit0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedTextId -> XParse FormattedTextId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-words") (XParse FormattedTextId
parseFormattedTextId))
      XParse ChxCredit0 -> XParse ChxCredit0 -> XParse ChxCredit0
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FormattedSymbolId -> ChxCredit0
CreditCreditSymbol
        (FormattedSymbolId -> ChxCredit0)
-> XParse FormattedSymbolId -> XParse ChxCredit0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedSymbolId -> XParse FormattedSymbolId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-symbol") (XParse FormattedSymbolId
parseFormattedSymbolId))

-- | Smart constructor for 'CreditCreditWords'
mkCreditCreditWords :: FormattedTextId -> ChxCredit0
mkCreditCreditWords :: FormattedTextId -> ChxCredit0
mkCreditCreditWords FormattedTextId
a = FormattedTextId -> ChxCredit0
CreditCreditWords FormattedTextId
a
-- | Smart constructor for 'CreditCreditSymbol'
mkCreditCreditSymbol :: FormattedSymbolId -> ChxCredit0
mkCreditCreditSymbol :: FormattedSymbolId -> ChxCredit0
mkCreditCreditSymbol FormattedSymbolId
a = FormattedSymbolId -> ChxCredit0
CreditCreditSymbol FormattedSymbolId
a

-- | @credit@ /(choice)/

-- mangled: 1
data ChxCredit1 = 
      ChxCreditCreditWords {
          ChxCredit1 -> FormattedTextId
chxcreditCreditWords :: FormattedTextId -- ^ /credit-words/ child element
       }
    | ChxCreditCreditSymbol {
          ChxCredit1 -> FormattedSymbolId
chxcreditCreditSymbol :: FormattedSymbolId -- ^ /credit-symbol/ child element
       }
    deriving (ChxCredit1 -> ChxCredit1 -> Bool
(ChxCredit1 -> ChxCredit1 -> Bool)
-> (ChxCredit1 -> ChxCredit1 -> Bool) -> Eq ChxCredit1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxCredit1 -> ChxCredit1 -> Bool
$c/= :: ChxCredit1 -> ChxCredit1 -> Bool
== :: ChxCredit1 -> ChxCredit1 -> Bool
$c== :: ChxCredit1 -> ChxCredit1 -> Bool
Eq,Typeable,(forall x. ChxCredit1 -> Rep ChxCredit1 x)
-> (forall x. Rep ChxCredit1 x -> ChxCredit1) -> Generic ChxCredit1
forall x. Rep ChxCredit1 x -> ChxCredit1
forall x. ChxCredit1 -> Rep ChxCredit1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxCredit1 x -> ChxCredit1
$cfrom :: forall x. ChxCredit1 -> Rep ChxCredit1 x
Generic,Int -> ChxCredit1 -> ShowS
[ChxCredit1] -> ShowS
ChxCredit1 -> String
(Int -> ChxCredit1 -> ShowS)
-> (ChxCredit1 -> String)
-> ([ChxCredit1] -> ShowS)
-> Show ChxCredit1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxCredit1] -> ShowS
$cshowList :: [ChxCredit1] -> ShowS
show :: ChxCredit1 -> String
$cshow :: ChxCredit1 -> String
showsPrec :: Int -> ChxCredit1 -> ShowS
$cshowsPrec :: Int -> ChxCredit1 -> ShowS
Show)
instance EmitXml ChxCredit1 where
    emitXml :: ChxCredit1 -> XmlRep
emitXml (ChxCreditCreditWords FormattedTextId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-words" Maybe String
forall a. Maybe a
Nothing) (FormattedTextId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedTextId
a)])
    emitXml (ChxCreditCreditSymbol FormattedSymbolId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-symbol" Maybe String
forall a. Maybe a
Nothing) (FormattedSymbolId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedSymbolId
a)])
parseChxCredit1 :: P.XParse ChxCredit1
parseChxCredit1 :: XParse ChxCredit1
parseChxCredit1 = 
      FormattedTextId -> ChxCredit1
ChxCreditCreditWords
        (FormattedTextId -> ChxCredit1)
-> XParse FormattedTextId -> XParse ChxCredit1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedTextId -> XParse FormattedTextId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-words") (XParse FormattedTextId
parseFormattedTextId))
      XParse ChxCredit1 -> XParse ChxCredit1 -> XParse ChxCredit1
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FormattedSymbolId -> ChxCredit1
ChxCreditCreditSymbol
        (FormattedSymbolId -> ChxCredit1)
-> XParse FormattedSymbolId -> XParse ChxCredit1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedSymbolId -> XParse FormattedSymbolId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-symbol") (XParse FormattedSymbolId
parseFormattedSymbolId))

-- | Smart constructor for 'ChxCreditCreditWords'
mkChxCreditCreditWords :: FormattedTextId -> ChxCredit1
mkChxCreditCreditWords :: FormattedTextId -> ChxCredit1
mkChxCreditCreditWords FormattedTextId
a = FormattedTextId -> ChxCredit1
ChxCreditCreditWords FormattedTextId
a
-- | Smart constructor for 'ChxCreditCreditSymbol'
mkChxCreditCreditSymbol :: FormattedSymbolId -> ChxCredit1
mkChxCreditCreditSymbol :: FormattedSymbolId -> ChxCredit1
mkChxCreditCreditSymbol FormattedSymbolId
a = FormattedSymbolId -> ChxCredit1
ChxCreditCreditSymbol FormattedSymbolId
a

-- | @credit@ /(choice)/

-- mangled: 2
data ChxCredit = 
      CreditCreditImage {
          ChxCredit -> Image
creditCreditImage :: Image -- ^ /credit-image/ child element
       }
    | CreditCredit {
          ChxCredit -> ChxCredit0
chxcreditCredit :: ChxCredit0
        , ChxCredit -> [SeqCredit]
creditCredit1 :: [SeqCredit]
       }
    deriving (ChxCredit -> ChxCredit -> Bool
(ChxCredit -> ChxCredit -> Bool)
-> (ChxCredit -> ChxCredit -> Bool) -> Eq ChxCredit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxCredit -> ChxCredit -> Bool
$c/= :: ChxCredit -> ChxCredit -> Bool
== :: ChxCredit -> ChxCredit -> Bool
$c== :: ChxCredit -> ChxCredit -> Bool
Eq,Typeable,(forall x. ChxCredit -> Rep ChxCredit x)
-> (forall x. Rep ChxCredit x -> ChxCredit) -> Generic ChxCredit
forall x. Rep ChxCredit x -> ChxCredit
forall x. ChxCredit -> Rep ChxCredit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxCredit x -> ChxCredit
$cfrom :: forall x. ChxCredit -> Rep ChxCredit x
Generic,Int -> ChxCredit -> ShowS
[ChxCredit] -> ShowS
ChxCredit -> String
(Int -> ChxCredit -> ShowS)
-> (ChxCredit -> String)
-> ([ChxCredit] -> ShowS)
-> Show ChxCredit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxCredit] -> ShowS
$cshowList :: [ChxCredit] -> ShowS
show :: ChxCredit -> String
$cshow :: ChxCredit -> String
showsPrec :: Int -> ChxCredit -> ShowS
$cshowsPrec :: Int -> ChxCredit -> ShowS
Show)
instance EmitXml ChxCredit where
    emitXml :: ChxCredit -> XmlRep
emitXml (CreditCreditImage Image
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit-image" Maybe String
forall a. Maybe a
Nothing) (Image -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Image
a)])
    emitXml (CreditCredit ChxCredit0
a [SeqCredit]
b) =
      [XmlRep] -> XmlRep
XReps [ChxCredit0 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxCredit0
a,[SeqCredit] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [SeqCredit]
b]
parseChxCredit :: P.XParse ChxCredit
parseChxCredit :: XParse ChxCredit
parseChxCredit = 
      Image -> ChxCredit
CreditCreditImage
        (Image -> ChxCredit) -> XParse Image -> XParse ChxCredit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Image -> XParse Image
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit-image") (XParse Image
parseImage))
      XParse ChxCredit -> XParse ChxCredit -> XParse ChxCredit
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ChxCredit0 -> [SeqCredit] -> ChxCredit
CreditCredit
        (ChxCredit0 -> [SeqCredit] -> ChxCredit)
-> XParse ChxCredit0 -> XParse ([SeqCredit] -> ChxCredit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxCredit0
parseChxCredit0
        XParse ([SeqCredit] -> ChxCredit)
-> XParse [SeqCredit] -> XParse ChxCredit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqCredit -> XParse [SeqCredit]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse SeqCredit
parseSeqCredit)

-- | Smart constructor for 'CreditCreditImage'
mkCreditCreditImage :: Image -> ChxCredit
mkCreditCreditImage :: Image -> ChxCredit
mkCreditCreditImage Image
a = Image -> ChxCredit
CreditCreditImage Image
a
-- | Smart constructor for 'CreditCredit'
mkCreditCredit :: ChxCredit0 -> ChxCredit
mkCreditCredit :: ChxCredit0 -> ChxCredit
mkCreditCredit ChxCredit0
a = ChxCredit0 -> [SeqCredit] -> ChxCredit
CreditCredit ChxCredit0
a []

-- | @direction-type@ /(choice)/
data ChxDirectionType0 = 
      DirectionTypeWords {
          ChxDirectionType0 -> FormattedTextId
directionTypeWords :: FormattedTextId -- ^ /words/ child element
       }
    | DirectionTypeSymbol {
          ChxDirectionType0 -> FormattedSymbolId
directionTypeSymbol :: FormattedSymbolId -- ^ /symbol/ child element
       }
    deriving (ChxDirectionType0 -> ChxDirectionType0 -> Bool
(ChxDirectionType0 -> ChxDirectionType0 -> Bool)
-> (ChxDirectionType0 -> ChxDirectionType0 -> Bool)
-> Eq ChxDirectionType0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxDirectionType0 -> ChxDirectionType0 -> Bool
$c/= :: ChxDirectionType0 -> ChxDirectionType0 -> Bool
== :: ChxDirectionType0 -> ChxDirectionType0 -> Bool
$c== :: ChxDirectionType0 -> ChxDirectionType0 -> Bool
Eq,Typeable,(forall x. ChxDirectionType0 -> Rep ChxDirectionType0 x)
-> (forall x. Rep ChxDirectionType0 x -> ChxDirectionType0)
-> Generic ChxDirectionType0
forall x. Rep ChxDirectionType0 x -> ChxDirectionType0
forall x. ChxDirectionType0 -> Rep ChxDirectionType0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxDirectionType0 x -> ChxDirectionType0
$cfrom :: forall x. ChxDirectionType0 -> Rep ChxDirectionType0 x
Generic,Int -> ChxDirectionType0 -> ShowS
[ChxDirectionType0] -> ShowS
ChxDirectionType0 -> String
(Int -> ChxDirectionType0 -> ShowS)
-> (ChxDirectionType0 -> String)
-> ([ChxDirectionType0] -> ShowS)
-> Show ChxDirectionType0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxDirectionType0] -> ShowS
$cshowList :: [ChxDirectionType0] -> ShowS
show :: ChxDirectionType0 -> String
$cshow :: ChxDirectionType0 -> String
showsPrec :: Int -> ChxDirectionType0 -> ShowS
$cshowsPrec :: Int -> ChxDirectionType0 -> ShowS
Show)
instance EmitXml ChxDirectionType0 where
    emitXml :: ChxDirectionType0 -> XmlRep
emitXml (DirectionTypeWords FormattedTextId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"words" Maybe String
forall a. Maybe a
Nothing) (FormattedTextId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedTextId
a)])
    emitXml (DirectionTypeSymbol FormattedSymbolId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"symbol" Maybe String
forall a. Maybe a
Nothing) (FormattedSymbolId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedSymbolId
a)])
parseChxDirectionType0 :: P.XParse ChxDirectionType0
parseChxDirectionType0 :: XParse ChxDirectionType0
parseChxDirectionType0 = 
      FormattedTextId -> ChxDirectionType0
DirectionTypeWords
        (FormattedTextId -> ChxDirectionType0)
-> XParse FormattedTextId -> XParse ChxDirectionType0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedTextId -> XParse FormattedTextId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"words") (XParse FormattedTextId
parseFormattedTextId))
      XParse ChxDirectionType0
-> XParse ChxDirectionType0 -> XParse ChxDirectionType0
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FormattedSymbolId -> ChxDirectionType0
DirectionTypeSymbol
        (FormattedSymbolId -> ChxDirectionType0)
-> XParse FormattedSymbolId -> XParse ChxDirectionType0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedSymbolId -> XParse FormattedSymbolId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"symbol") (XParse FormattedSymbolId
parseFormattedSymbolId))

-- | Smart constructor for 'DirectionTypeWords'
mkDirectionTypeWords :: FormattedTextId -> ChxDirectionType0
mkDirectionTypeWords :: FormattedTextId -> ChxDirectionType0
mkDirectionTypeWords FormattedTextId
a = FormattedTextId -> ChxDirectionType0
DirectionTypeWords FormattedTextId
a
-- | Smart constructor for 'DirectionTypeSymbol'
mkDirectionTypeSymbol :: FormattedSymbolId -> ChxDirectionType0
mkDirectionTypeSymbol :: FormattedSymbolId -> ChxDirectionType0
mkDirectionTypeSymbol FormattedSymbolId
a = FormattedSymbolId -> ChxDirectionType0
DirectionTypeSymbol FormattedSymbolId
a

-- | @direction-type@ /(choice)/

-- mangled: 1
data ChxDirectionType = 
      DirectionTypeRehearsal {
          ChxDirectionType -> [FormattedTextId]
directionTypeRehearsal :: [FormattedTextId] -- ^ /rehearsal/ child element
       }
    | DirectionTypeSegno {
          ChxDirectionType -> [Segno]
directionTypeSegno :: [Segno] -- ^ /segno/ child element
       }
    | DirectionTypeCoda {
          ChxDirectionType -> [Coda]
directionTypeCoda :: [Coda] -- ^ /coda/ child element
       }
    | DirectionTypeDirectionType {
          ChxDirectionType -> [ChxDirectionType0]
chxdirectionTypeDirectionType :: [ChxDirectionType0]
       }
    | DirectionTypeWedge {
          ChxDirectionType -> Wedge
directionTypeWedge :: Wedge -- ^ /wedge/ child element
       }
    | DirectionTypeDynamics {
          ChxDirectionType -> [Dynamics]
directionTypeDynamics :: [Dynamics] -- ^ /dynamics/ child element
       }
    | DirectionTypeDashes {
          ChxDirectionType -> Dashes
directionTypeDashes :: Dashes -- ^ /dashes/ child element
       }
    | DirectionTypeBracket {
          ChxDirectionType -> Bracket
directionTypeBracket :: Bracket -- ^ /bracket/ child element
       }
    | DirectionTypePedal {
          ChxDirectionType -> Pedal
directionTypePedal :: Pedal -- ^ /pedal/ child element
       }
    | DirectionTypeMetronome {
          ChxDirectionType -> Metronome
directionTypeMetronome :: Metronome -- ^ /metronome/ child element
       }
    | DirectionTypeOctaveShift {
          ChxDirectionType -> OctaveShift
directionTypeOctaveShift :: OctaveShift -- ^ /octave-shift/ child element
       }
    | DirectionTypeHarpPedals {
          ChxDirectionType -> HarpPedals
directionTypeHarpPedals :: HarpPedals -- ^ /harp-pedals/ child element
       }
    | DirectionTypeDamp {
          ChxDirectionType -> EmptyPrintStyleAlignId
directionTypeDamp :: EmptyPrintStyleAlignId -- ^ /damp/ child element
       }
    | DirectionTypeDampAll {
          ChxDirectionType -> EmptyPrintStyleAlignId
directionTypeDampAll :: EmptyPrintStyleAlignId -- ^ /damp-all/ child element
       }
    | DirectionTypeEyeglasses {
          ChxDirectionType -> EmptyPrintStyleAlignId
directionTypeEyeglasses :: EmptyPrintStyleAlignId -- ^ /eyeglasses/ child element
       }
    | DirectionTypeStringMute {
          ChxDirectionType -> StringMute
directionTypeStringMute :: StringMute -- ^ /string-mute/ child element
       }
    | DirectionTypeScordatura {
          ChxDirectionType -> Scordatura
directionTypeScordatura :: Scordatura -- ^ /scordatura/ child element
       }
    | DirectionTypeImage {
          ChxDirectionType -> Image
directionTypeImage :: Image -- ^ /image/ child element
       }
    | DirectionTypePrincipalVoice {
          ChxDirectionType -> PrincipalVoice
directionTypePrincipalVoice :: PrincipalVoice -- ^ /principal-voice/ child element
       }
    | DirectionTypePercussion {
          ChxDirectionType -> [Percussion]
directionTypePercussion :: [Percussion] -- ^ /percussion/ child element
       }
    | DirectionTypeAccordionRegistration {
          ChxDirectionType -> AccordionRegistration
directionTypeAccordionRegistration :: AccordionRegistration -- ^ /accordion-registration/ child element
       }
    | DirectionTypeStaffDivide {
          ChxDirectionType -> StaffDivide
directionTypeStaffDivide :: StaffDivide -- ^ /staff-divide/ child element
       }
    | DirectionTypeOtherDirection {
          ChxDirectionType -> OtherDirection
directionTypeOtherDirection :: OtherDirection -- ^ /other-direction/ child element
       }
    deriving (ChxDirectionType -> ChxDirectionType -> Bool
(ChxDirectionType -> ChxDirectionType -> Bool)
-> (ChxDirectionType -> ChxDirectionType -> Bool)
-> Eq ChxDirectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxDirectionType -> ChxDirectionType -> Bool
$c/= :: ChxDirectionType -> ChxDirectionType -> Bool
== :: ChxDirectionType -> ChxDirectionType -> Bool
$c== :: ChxDirectionType -> ChxDirectionType -> Bool
Eq,Typeable,(forall x. ChxDirectionType -> Rep ChxDirectionType x)
-> (forall x. Rep ChxDirectionType x -> ChxDirectionType)
-> Generic ChxDirectionType
forall x. Rep ChxDirectionType x -> ChxDirectionType
forall x. ChxDirectionType -> Rep ChxDirectionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxDirectionType x -> ChxDirectionType
$cfrom :: forall x. ChxDirectionType -> Rep ChxDirectionType x
Generic,Int -> ChxDirectionType -> ShowS
[ChxDirectionType] -> ShowS
ChxDirectionType -> String
(Int -> ChxDirectionType -> ShowS)
-> (ChxDirectionType -> String)
-> ([ChxDirectionType] -> ShowS)
-> Show ChxDirectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxDirectionType] -> ShowS
$cshowList :: [ChxDirectionType] -> ShowS
show :: ChxDirectionType -> String
$cshow :: ChxDirectionType -> String
showsPrec :: Int -> ChxDirectionType -> ShowS
$cshowsPrec :: Int -> ChxDirectionType -> ShowS
Show)
instance EmitXml ChxDirectionType where
    emitXml :: ChxDirectionType -> XmlRep
emitXml (DirectionTypeRehearsal [FormattedTextId]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((FormattedTextId -> XmlRep) -> [FormattedTextId] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"rehearsal" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (FormattedTextId -> XmlRep) -> FormattedTextId -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FormattedTextId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [FormattedTextId]
a)
    emitXml (DirectionTypeSegno [Segno]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((Segno -> XmlRep) -> [Segno] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"segno" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Segno -> XmlRep) -> Segno -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Segno -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Segno]
a)
    emitXml (DirectionTypeCoda [Coda]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((Coda -> XmlRep) -> [Coda] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"coda" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Coda -> XmlRep) -> Coda -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Coda -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Coda]
a)
    emitXml (DirectionTypeDirectionType [ChxDirectionType0]
a) =
      [XmlRep] -> XmlRep
XReps [[ChxDirectionType0] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxDirectionType0]
a]
    emitXml (DirectionTypeWedge Wedge
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"wedge" Maybe String
forall a. Maybe a
Nothing) (Wedge -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Wedge
a)])
    emitXml (DirectionTypeDynamics [Dynamics]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((Dynamics -> XmlRep) -> [Dynamics] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"dynamics" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Dynamics -> XmlRep) -> Dynamics -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Dynamics -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Dynamics]
a)
    emitXml (DirectionTypeDashes Dashes
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"dashes" Maybe String
forall a. Maybe a
Nothing) (Dashes -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Dashes
a)])
    emitXml (DirectionTypeBracket Bracket
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bracket" Maybe String
forall a. Maybe a
Nothing) (Bracket -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Bracket
a)])
    emitXml (DirectionTypePedal Pedal
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pedal" Maybe String
forall a. Maybe a
Nothing) (Pedal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Pedal
a)])
    emitXml (DirectionTypeMetronome Metronome
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome" Maybe String
forall a. Maybe a
Nothing) (Metronome -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Metronome
a)])
    emitXml (DirectionTypeOctaveShift OctaveShift
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"octave-shift" Maybe String
forall a. Maybe a
Nothing) (OctaveShift -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OctaveShift
a)])
    emitXml (DirectionTypeHarpPedals HarpPedals
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"harp-pedals" Maybe String
forall a. Maybe a
Nothing) (HarpPedals -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HarpPedals
a)])
    emitXml (DirectionTypeDamp EmptyPrintStyleAlignId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"damp" Maybe String
forall a. Maybe a
Nothing) (EmptyPrintStyleAlignId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPrintStyleAlignId
a)])
    emitXml (DirectionTypeDampAll EmptyPrintStyleAlignId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"damp-all" Maybe String
forall a. Maybe a
Nothing) (EmptyPrintStyleAlignId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPrintStyleAlignId
a)])
    emitXml (DirectionTypeEyeglasses EmptyPrintStyleAlignId
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"eyeglasses" Maybe String
forall a. Maybe a
Nothing) (EmptyPrintStyleAlignId -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPrintStyleAlignId
a)])
    emitXml (DirectionTypeStringMute StringMute
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"string-mute" Maybe String
forall a. Maybe a
Nothing) (StringMute -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StringMute
a)])
    emitXml (DirectionTypeScordatura Scordatura
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"scordatura" Maybe String
forall a. Maybe a
Nothing) (Scordatura -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Scordatura
a)])
    emitXml (DirectionTypeImage Image
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"image" Maybe String
forall a. Maybe a
Nothing) (Image -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Image
a)])
    emitXml (DirectionTypePrincipalVoice PrincipalVoice
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"principal-voice" Maybe String
forall a. Maybe a
Nothing) (PrincipalVoice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PrincipalVoice
a)])
    emitXml (DirectionTypePercussion [Percussion]
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((Percussion -> XmlRep) -> [Percussion] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"percussion" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Percussion -> XmlRep) -> Percussion -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Percussion -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Percussion]
a)
    emitXml (DirectionTypeAccordionRegistration AccordionRegistration
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accordion-registration" Maybe String
forall a. Maybe a
Nothing) (AccordionRegistration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccordionRegistration
a)])
    emitXml (DirectionTypeStaffDivide StaffDivide
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-divide" Maybe String
forall a. Maybe a
Nothing) (StaffDivide -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StaffDivide
a)])
    emitXml (DirectionTypeOtherDirection OtherDirection
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-direction" Maybe String
forall a. Maybe a
Nothing) (OtherDirection -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherDirection
a)])
parseChxDirectionType :: P.XParse ChxDirectionType
parseChxDirectionType :: XParse ChxDirectionType
parseChxDirectionType = 
      [FormattedTextId] -> ChxDirectionType
DirectionTypeRehearsal
        ([FormattedTextId] -> ChxDirectionType)
-> XParse [FormattedTextId] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse FormattedTextId -> XParse [FormattedTextId]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some (QName -> XParse FormattedTextId -> XParse FormattedTextId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"rehearsal") (XParse FormattedTextId
parseFormattedTextId))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Segno] -> ChxDirectionType
DirectionTypeSegno
        ([Segno] -> ChxDirectionType)
-> XParse [Segno] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Segno -> XParse [Segno]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some (QName -> XParse Segno -> XParse Segno
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"segno") (XParse Segno
parseSegno))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Coda] -> ChxDirectionType
DirectionTypeCoda
        ([Coda] -> ChxDirectionType)
-> XParse [Coda] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Coda -> XParse [Coda]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some (QName -> XParse Coda -> XParse Coda
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"coda") (XParse Coda
parseCoda))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ChxDirectionType0] -> ChxDirectionType
DirectionTypeDirectionType
        ([ChxDirectionType0] -> ChxDirectionType)
-> XParse [ChxDirectionType0] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxDirectionType0 -> XParse [ChxDirectionType0]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxDirectionType0
parseChxDirectionType0)
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Wedge -> ChxDirectionType
DirectionTypeWedge
        (Wedge -> ChxDirectionType)
-> XParse Wedge -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Wedge -> XParse Wedge
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"wedge") (XParse Wedge
parseWedge))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Dynamics] -> ChxDirectionType
DirectionTypeDynamics
        ([Dynamics] -> ChxDirectionType)
-> XParse [Dynamics] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Dynamics -> XParse [Dynamics]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some (QName -> XParse Dynamics -> XParse Dynamics
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"dynamics") (XParse Dynamics
parseDynamics))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dashes -> ChxDirectionType
DirectionTypeDashes
        (Dashes -> ChxDirectionType)
-> XParse Dashes -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Dashes -> XParse Dashes
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"dashes") (XParse Dashes
parseDashes))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bracket -> ChxDirectionType
DirectionTypeBracket
        (Bracket -> ChxDirectionType)
-> XParse Bracket -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Bracket -> XParse Bracket
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bracket") (XParse Bracket
parseBracket))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pedal -> ChxDirectionType
DirectionTypePedal
        (Pedal -> ChxDirectionType)
-> XParse Pedal -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Pedal -> XParse Pedal
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pedal") (XParse Pedal
parsePedal))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Metronome -> ChxDirectionType
DirectionTypeMetronome
        (Metronome -> ChxDirectionType)
-> XParse Metronome -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Metronome -> XParse Metronome
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome") (XParse Metronome
parseMetronome))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OctaveShift -> ChxDirectionType
DirectionTypeOctaveShift
        (OctaveShift -> ChxDirectionType)
-> XParse OctaveShift -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OctaveShift -> XParse OctaveShift
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"octave-shift") (XParse OctaveShift
parseOctaveShift))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HarpPedals -> ChxDirectionType
DirectionTypeHarpPedals
        (HarpPedals -> ChxDirectionType)
-> XParse HarpPedals -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HarpPedals -> XParse HarpPedals
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"harp-pedals") (XParse HarpPedals
parseHarpPedals))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeDamp
        (EmptyPrintStyleAlignId -> ChxDirectionType)
-> XParse EmptyPrintStyleAlignId -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse EmptyPrintStyleAlignId -> XParse EmptyPrintStyleAlignId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"damp") (XParse EmptyPrintStyleAlignId
parseEmptyPrintStyleAlignId))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeDampAll
        (EmptyPrintStyleAlignId -> ChxDirectionType)
-> XParse EmptyPrintStyleAlignId -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse EmptyPrintStyleAlignId -> XParse EmptyPrintStyleAlignId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"damp-all") (XParse EmptyPrintStyleAlignId
parseEmptyPrintStyleAlignId))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeEyeglasses
        (EmptyPrintStyleAlignId -> ChxDirectionType)
-> XParse EmptyPrintStyleAlignId -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse EmptyPrintStyleAlignId -> XParse EmptyPrintStyleAlignId
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"eyeglasses") (XParse EmptyPrintStyleAlignId
parseEmptyPrintStyleAlignId))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StringMute -> ChxDirectionType
DirectionTypeStringMute
        (StringMute -> ChxDirectionType)
-> XParse StringMute -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse StringMute -> XParse StringMute
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"string-mute") (XParse StringMute
parseStringMute))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scordatura -> ChxDirectionType
DirectionTypeScordatura
        (Scordatura -> ChxDirectionType)
-> XParse Scordatura -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Scordatura -> XParse Scordatura
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"scordatura") (XParse Scordatura
parseScordatura))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Image -> ChxDirectionType
DirectionTypeImage
        (Image -> ChxDirectionType)
-> XParse Image -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Image -> XParse Image
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"image") (XParse Image
parseImage))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PrincipalVoice -> ChxDirectionType
DirectionTypePrincipalVoice
        (PrincipalVoice -> ChxDirectionType)
-> XParse PrincipalVoice -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PrincipalVoice -> XParse PrincipalVoice
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"principal-voice") (XParse PrincipalVoice
parsePrincipalVoice))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Percussion] -> ChxDirectionType
DirectionTypePercussion
        ([Percussion] -> ChxDirectionType)
-> XParse [Percussion] -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Percussion -> XParse [Percussion]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.some (QName -> XParse Percussion -> XParse Percussion
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"percussion") (XParse Percussion
parsePercussion))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AccordionRegistration -> ChxDirectionType
DirectionTypeAccordionRegistration
        (AccordionRegistration -> ChxDirectionType)
-> XParse AccordionRegistration -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse AccordionRegistration -> XParse AccordionRegistration
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accordion-registration") (XParse AccordionRegistration
parseAccordionRegistration))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StaffDivide -> ChxDirectionType
DirectionTypeStaffDivide
        (StaffDivide -> ChxDirectionType)
-> XParse StaffDivide -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse StaffDivide -> XParse StaffDivide
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-divide") (XParse StaffDivide
parseStaffDivide))
      XParse ChxDirectionType
-> XParse ChxDirectionType -> XParse ChxDirectionType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherDirection -> ChxDirectionType
DirectionTypeOtherDirection
        (OtherDirection -> ChxDirectionType)
-> XParse OtherDirection -> XParse ChxDirectionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherDirection -> XParse OtherDirection
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-direction") (XParse OtherDirection
parseOtherDirection))

-- | Smart constructor for 'DirectionTypeRehearsal'
mkDirectionTypeRehearsal :: ChxDirectionType
mkDirectionTypeRehearsal :: ChxDirectionType
mkDirectionTypeRehearsal = [FormattedTextId] -> ChxDirectionType
DirectionTypeRehearsal []
-- | Smart constructor for 'DirectionTypeSegno'
mkDirectionTypeSegno :: ChxDirectionType
mkDirectionTypeSegno :: ChxDirectionType
mkDirectionTypeSegno = [Segno] -> ChxDirectionType
DirectionTypeSegno []
-- | Smart constructor for 'DirectionTypeCoda'
mkDirectionTypeCoda :: ChxDirectionType
mkDirectionTypeCoda :: ChxDirectionType
mkDirectionTypeCoda = [Coda] -> ChxDirectionType
DirectionTypeCoda []
-- | Smart constructor for 'DirectionTypeDirectionType'
mkDirectionTypeDirectionType :: ChxDirectionType
mkDirectionTypeDirectionType :: ChxDirectionType
mkDirectionTypeDirectionType = [ChxDirectionType0] -> ChxDirectionType
DirectionTypeDirectionType []
-- | Smart constructor for 'DirectionTypeWedge'
mkDirectionTypeWedge :: Wedge -> ChxDirectionType
mkDirectionTypeWedge :: Wedge -> ChxDirectionType
mkDirectionTypeWedge Wedge
a = Wedge -> ChxDirectionType
DirectionTypeWedge Wedge
a
-- | Smart constructor for 'DirectionTypeDynamics'
mkDirectionTypeDynamics :: ChxDirectionType
mkDirectionTypeDynamics :: ChxDirectionType
mkDirectionTypeDynamics = [Dynamics] -> ChxDirectionType
DirectionTypeDynamics []
-- | Smart constructor for 'DirectionTypeDashes'
mkDirectionTypeDashes :: Dashes -> ChxDirectionType
mkDirectionTypeDashes :: Dashes -> ChxDirectionType
mkDirectionTypeDashes Dashes
a = Dashes -> ChxDirectionType
DirectionTypeDashes Dashes
a
-- | Smart constructor for 'DirectionTypeBracket'
mkDirectionTypeBracket :: Bracket -> ChxDirectionType
mkDirectionTypeBracket :: Bracket -> ChxDirectionType
mkDirectionTypeBracket Bracket
a = Bracket -> ChxDirectionType
DirectionTypeBracket Bracket
a
-- | Smart constructor for 'DirectionTypePedal'
mkDirectionTypePedal :: Pedal -> ChxDirectionType
mkDirectionTypePedal :: Pedal -> ChxDirectionType
mkDirectionTypePedal Pedal
a = Pedal -> ChxDirectionType
DirectionTypePedal Pedal
a
-- | Smart constructor for 'DirectionTypeMetronome'
mkDirectionTypeMetronome :: Metronome -> ChxDirectionType
mkDirectionTypeMetronome :: Metronome -> ChxDirectionType
mkDirectionTypeMetronome Metronome
a = Metronome -> ChxDirectionType
DirectionTypeMetronome Metronome
a
-- | Smart constructor for 'DirectionTypeOctaveShift'
mkDirectionTypeOctaveShift :: OctaveShift -> ChxDirectionType
mkDirectionTypeOctaveShift :: OctaveShift -> ChxDirectionType
mkDirectionTypeOctaveShift OctaveShift
a = OctaveShift -> ChxDirectionType
DirectionTypeOctaveShift OctaveShift
a
-- | Smart constructor for 'DirectionTypeHarpPedals'
mkDirectionTypeHarpPedals :: HarpPedals -> ChxDirectionType
mkDirectionTypeHarpPedals :: HarpPedals -> ChxDirectionType
mkDirectionTypeHarpPedals HarpPedals
a = HarpPedals -> ChxDirectionType
DirectionTypeHarpPedals HarpPedals
a
-- | Smart constructor for 'DirectionTypeDamp'
mkDirectionTypeDamp :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeDamp :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeDamp EmptyPrintStyleAlignId
a = EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeDamp EmptyPrintStyleAlignId
a
-- | Smart constructor for 'DirectionTypeDampAll'
mkDirectionTypeDampAll :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeDampAll :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeDampAll EmptyPrintStyleAlignId
a = EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeDampAll EmptyPrintStyleAlignId
a
-- | Smart constructor for 'DirectionTypeEyeglasses'
mkDirectionTypeEyeglasses :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeEyeglasses :: EmptyPrintStyleAlignId -> ChxDirectionType
mkDirectionTypeEyeglasses EmptyPrintStyleAlignId
a = EmptyPrintStyleAlignId -> ChxDirectionType
DirectionTypeEyeglasses EmptyPrintStyleAlignId
a
-- | Smart constructor for 'DirectionTypeStringMute'
mkDirectionTypeStringMute :: StringMute -> ChxDirectionType
mkDirectionTypeStringMute :: StringMute -> ChxDirectionType
mkDirectionTypeStringMute StringMute
a = StringMute -> ChxDirectionType
DirectionTypeStringMute StringMute
a
-- | Smart constructor for 'DirectionTypeScordatura'
mkDirectionTypeScordatura :: Scordatura -> ChxDirectionType
mkDirectionTypeScordatura :: Scordatura -> ChxDirectionType
mkDirectionTypeScordatura Scordatura
a = Scordatura -> ChxDirectionType
DirectionTypeScordatura Scordatura
a
-- | Smart constructor for 'DirectionTypeImage'
mkDirectionTypeImage :: Image -> ChxDirectionType
mkDirectionTypeImage :: Image -> ChxDirectionType
mkDirectionTypeImage Image
a = Image -> ChxDirectionType
DirectionTypeImage Image
a
-- | Smart constructor for 'DirectionTypePrincipalVoice'
mkDirectionTypePrincipalVoice :: PrincipalVoice -> ChxDirectionType
mkDirectionTypePrincipalVoice :: PrincipalVoice -> ChxDirectionType
mkDirectionTypePrincipalVoice PrincipalVoice
a = PrincipalVoice -> ChxDirectionType
DirectionTypePrincipalVoice PrincipalVoice
a
-- | Smart constructor for 'DirectionTypePercussion'
mkDirectionTypePercussion :: ChxDirectionType
mkDirectionTypePercussion :: ChxDirectionType
mkDirectionTypePercussion = [Percussion] -> ChxDirectionType
DirectionTypePercussion []
-- | Smart constructor for 'DirectionTypeAccordionRegistration'
mkDirectionTypeAccordionRegistration :: AccordionRegistration -> ChxDirectionType
mkDirectionTypeAccordionRegistration :: AccordionRegistration -> ChxDirectionType
mkDirectionTypeAccordionRegistration AccordionRegistration
a = AccordionRegistration -> ChxDirectionType
DirectionTypeAccordionRegistration AccordionRegistration
a
-- | Smart constructor for 'DirectionTypeStaffDivide'
mkDirectionTypeStaffDivide :: StaffDivide -> ChxDirectionType
mkDirectionTypeStaffDivide :: StaffDivide -> ChxDirectionType
mkDirectionTypeStaffDivide StaffDivide
a = StaffDivide -> ChxDirectionType
DirectionTypeStaffDivide StaffDivide
a
-- | Smart constructor for 'DirectionTypeOtherDirection'
mkDirectionTypeOtherDirection :: OtherDirection -> ChxDirectionType
mkDirectionTypeOtherDirection :: OtherDirection -> ChxDirectionType
mkDirectionTypeOtherDirection OtherDirection
a = OtherDirection -> ChxDirectionType
DirectionTypeOtherDirection OtherDirection
a

-- | @dynamics@ /(choice)/
data ChxDynamics = 
      DynamicsP {
          ChxDynamics -> Empty
dynamicsP :: Empty -- ^ /p/ child element
       }
    | DynamicsPp {
          ChxDynamics -> Empty
dynamicsPp :: Empty -- ^ /pp/ child element
       }
    | DynamicsPpp {
          ChxDynamics -> Empty
dynamicsPpp :: Empty -- ^ /ppp/ child element
       }
    | DynamicsPppp {
          ChxDynamics -> Empty
dynamicsPppp :: Empty -- ^ /pppp/ child element
       }
    | DynamicsPpppp {
          ChxDynamics -> Empty
dynamicsPpppp :: Empty -- ^ /ppppp/ child element
       }
    | DynamicsPppppp {
          ChxDynamics -> Empty
dynamicsPppppp :: Empty -- ^ /pppppp/ child element
       }
    | DynamicsF {
          ChxDynamics -> Empty
dynamicsF :: Empty -- ^ /f/ child element
       }
    | DynamicsFf {
          ChxDynamics -> Empty
dynamicsFf :: Empty -- ^ /ff/ child element
       }
    | DynamicsFff {
          ChxDynamics -> Empty
dynamicsFff :: Empty -- ^ /fff/ child element
       }
    | DynamicsFfff {
          ChxDynamics -> Empty
dynamicsFfff :: Empty -- ^ /ffff/ child element
       }
    | DynamicsFffff {
          ChxDynamics -> Empty
dynamicsFffff :: Empty -- ^ /fffff/ child element
       }
    | DynamicsFfffff {
          ChxDynamics -> Empty
dynamicsFfffff :: Empty -- ^ /ffffff/ child element
       }
    | DynamicsMp {
          ChxDynamics -> Empty
dynamicsMp :: Empty -- ^ /mp/ child element
       }
    | DynamicsMf {
          ChxDynamics -> Empty
dynamicsMf :: Empty -- ^ /mf/ child element
       }
    | DynamicsSf {
          ChxDynamics -> Empty
dynamicsSf :: Empty -- ^ /sf/ child element
       }
    | DynamicsSfp {
          ChxDynamics -> Empty
dynamicsSfp :: Empty -- ^ /sfp/ child element
       }
    | DynamicsSfpp {
          ChxDynamics -> Empty
dynamicsSfpp :: Empty -- ^ /sfpp/ child element
       }
    | DynamicsFp {
          ChxDynamics -> Empty
dynamicsFp :: Empty -- ^ /fp/ child element
       }
    | DynamicsRf {
          ChxDynamics -> Empty
dynamicsRf :: Empty -- ^ /rf/ child element
       }
    | DynamicsRfz {
          ChxDynamics -> Empty
dynamicsRfz :: Empty -- ^ /rfz/ child element
       }
    | DynamicsSfz {
          ChxDynamics -> Empty
dynamicsSfz :: Empty -- ^ /sfz/ child element
       }
    | DynamicsSffz {
          ChxDynamics -> Empty
dynamicsSffz :: Empty -- ^ /sffz/ child element
       }
    | DynamicsFz {
          ChxDynamics -> Empty
dynamicsFz :: Empty -- ^ /fz/ child element
       }
    | DynamicsN {
          ChxDynamics -> Empty
dynamicsN :: Empty -- ^ /n/ child element
       }
    | DynamicsPf {
          ChxDynamics -> Empty
dynamicsPf :: Empty -- ^ /pf/ child element
       }
    | DynamicsSfzp {
          ChxDynamics -> Empty
dynamicsSfzp :: Empty -- ^ /sfzp/ child element
       }
    | DynamicsOtherDynamics {
          ChxDynamics -> OtherText
dynamicsOtherDynamics :: OtherText -- ^ /other-dynamics/ child element
       }
    deriving (ChxDynamics -> ChxDynamics -> Bool
(ChxDynamics -> ChxDynamics -> Bool)
-> (ChxDynamics -> ChxDynamics -> Bool) -> Eq ChxDynamics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxDynamics -> ChxDynamics -> Bool
$c/= :: ChxDynamics -> ChxDynamics -> Bool
== :: ChxDynamics -> ChxDynamics -> Bool
$c== :: ChxDynamics -> ChxDynamics -> Bool
Eq,Typeable,(forall x. ChxDynamics -> Rep ChxDynamics x)
-> (forall x. Rep ChxDynamics x -> ChxDynamics)
-> Generic ChxDynamics
forall x. Rep ChxDynamics x -> ChxDynamics
forall x. ChxDynamics -> Rep ChxDynamics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxDynamics x -> ChxDynamics
$cfrom :: forall x. ChxDynamics -> Rep ChxDynamics x
Generic,Int -> ChxDynamics -> ShowS
[ChxDynamics] -> ShowS
ChxDynamics -> String
(Int -> ChxDynamics -> ShowS)
-> (ChxDynamics -> String)
-> ([ChxDynamics] -> ShowS)
-> Show ChxDynamics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxDynamics] -> ShowS
$cshowList :: [ChxDynamics] -> ShowS
show :: ChxDynamics -> String
$cshow :: ChxDynamics -> String
showsPrec :: Int -> ChxDynamics -> ShowS
$cshowsPrec :: Int -> ChxDynamics -> ShowS
Show)
instance EmitXml ChxDynamics where
    emitXml :: ChxDynamics -> XmlRep
emitXml (DynamicsP Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"p" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPpp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ppp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPppp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pppp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPpppp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ppppp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPppppp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pppppp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsF Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"f" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFf Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ff" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFff Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fff" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFfff Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ffff" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFffff Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fffff" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFfffff Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ffffff" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsMp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"mp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsMf Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"mf" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSf Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sf" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSfp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sfp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSfpp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sfpp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsRf Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"rf" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsRfz Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"rfz" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSfz Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sfz" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSffz Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sffz" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsFz Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fz" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsN Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"n" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsPf Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pf" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsSfzp Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sfzp" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (DynamicsOtherDynamics OtherText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-dynamics" Maybe String
forall a. Maybe a
Nothing) (OtherText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherText
a)])
parseChxDynamics :: P.XParse ChxDynamics
parseChxDynamics :: XParse ChxDynamics
parseChxDynamics = 
      Empty -> ChxDynamics
DynamicsP
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"p") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPpp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ppp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPppp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pppp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPpppp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ppppp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPppppp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pppppp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsF
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"f") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFf
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ff") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFff
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fff") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFfff
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ffff") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFffff
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fffff") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFfffff
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ffffff") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsMp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"mp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsMf
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"mf") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSf
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sf") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSfp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sfp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSfpp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sfpp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsRf
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"rf") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsRfz
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"rfz") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSfz
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sfz") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSffz
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sffz") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsFz
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fz") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsN
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"n") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsPf
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pf") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxDynamics
DynamicsSfzp
        (Empty -> ChxDynamics) -> XParse Empty -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sfzp") (XParse Empty
parseEmpty))
      XParse ChxDynamics -> XParse ChxDynamics -> XParse ChxDynamics
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherText -> ChxDynamics
DynamicsOtherDynamics
        (OtherText -> ChxDynamics)
-> XParse OtherText -> XParse ChxDynamics
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherText -> XParse OtherText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-dynamics") (XParse OtherText
parseOtherText))

-- | Smart constructor for 'DynamicsP'
mkDynamicsP :: Empty -> ChxDynamics
mkDynamicsP :: Empty -> ChxDynamics
mkDynamicsP Empty
a = Empty -> ChxDynamics
DynamicsP Empty
a
-- | Smart constructor for 'DynamicsPp'
mkDynamicsPp :: Empty -> ChxDynamics
mkDynamicsPp :: Empty -> ChxDynamics
mkDynamicsPp Empty
a = Empty -> ChxDynamics
DynamicsPp Empty
a
-- | Smart constructor for 'DynamicsPpp'
mkDynamicsPpp :: Empty -> ChxDynamics
mkDynamicsPpp :: Empty -> ChxDynamics
mkDynamicsPpp Empty
a = Empty -> ChxDynamics
DynamicsPpp Empty
a
-- | Smart constructor for 'DynamicsPppp'
mkDynamicsPppp :: Empty -> ChxDynamics
mkDynamicsPppp :: Empty -> ChxDynamics
mkDynamicsPppp Empty
a = Empty -> ChxDynamics
DynamicsPppp Empty
a
-- | Smart constructor for 'DynamicsPpppp'
mkDynamicsPpppp :: Empty -> ChxDynamics
mkDynamicsPpppp :: Empty -> ChxDynamics
mkDynamicsPpppp Empty
a = Empty -> ChxDynamics
DynamicsPpppp Empty
a
-- | Smart constructor for 'DynamicsPppppp'
mkDynamicsPppppp :: Empty -> ChxDynamics
mkDynamicsPppppp :: Empty -> ChxDynamics
mkDynamicsPppppp Empty
a = Empty -> ChxDynamics
DynamicsPppppp Empty
a
-- | Smart constructor for 'DynamicsF'
mkDynamicsF :: Empty -> ChxDynamics
mkDynamicsF :: Empty -> ChxDynamics
mkDynamicsF Empty
a = Empty -> ChxDynamics
DynamicsF Empty
a
-- | Smart constructor for 'DynamicsFf'
mkDynamicsFf :: Empty -> ChxDynamics
mkDynamicsFf :: Empty -> ChxDynamics
mkDynamicsFf Empty
a = Empty -> ChxDynamics
DynamicsFf Empty
a
-- | Smart constructor for 'DynamicsFff'
mkDynamicsFff :: Empty -> ChxDynamics
mkDynamicsFff :: Empty -> ChxDynamics
mkDynamicsFff Empty
a = Empty -> ChxDynamics
DynamicsFff Empty
a
-- | Smart constructor for 'DynamicsFfff'
mkDynamicsFfff :: Empty -> ChxDynamics
mkDynamicsFfff :: Empty -> ChxDynamics
mkDynamicsFfff Empty
a = Empty -> ChxDynamics
DynamicsFfff Empty
a
-- | Smart constructor for 'DynamicsFffff'
mkDynamicsFffff :: Empty -> ChxDynamics
mkDynamicsFffff :: Empty -> ChxDynamics
mkDynamicsFffff Empty
a = Empty -> ChxDynamics
DynamicsFffff Empty
a
-- | Smart constructor for 'DynamicsFfffff'
mkDynamicsFfffff :: Empty -> ChxDynamics
mkDynamicsFfffff :: Empty -> ChxDynamics
mkDynamicsFfffff Empty
a = Empty -> ChxDynamics
DynamicsFfffff Empty
a
-- | Smart constructor for 'DynamicsMp'
mkDynamicsMp :: Empty -> ChxDynamics
mkDynamicsMp :: Empty -> ChxDynamics
mkDynamicsMp Empty
a = Empty -> ChxDynamics
DynamicsMp Empty
a
-- | Smart constructor for 'DynamicsMf'
mkDynamicsMf :: Empty -> ChxDynamics
mkDynamicsMf :: Empty -> ChxDynamics
mkDynamicsMf Empty
a = Empty -> ChxDynamics
DynamicsMf Empty
a
-- | Smart constructor for 'DynamicsSf'
mkDynamicsSf :: Empty -> ChxDynamics
mkDynamicsSf :: Empty -> ChxDynamics
mkDynamicsSf Empty
a = Empty -> ChxDynamics
DynamicsSf Empty
a
-- | Smart constructor for 'DynamicsSfp'
mkDynamicsSfp :: Empty -> ChxDynamics
mkDynamicsSfp :: Empty -> ChxDynamics
mkDynamicsSfp Empty
a = Empty -> ChxDynamics
DynamicsSfp Empty
a
-- | Smart constructor for 'DynamicsSfpp'
mkDynamicsSfpp :: Empty -> ChxDynamics
mkDynamicsSfpp :: Empty -> ChxDynamics
mkDynamicsSfpp Empty
a = Empty -> ChxDynamics
DynamicsSfpp Empty
a
-- | Smart constructor for 'DynamicsFp'
mkDynamicsFp :: Empty -> ChxDynamics
mkDynamicsFp :: Empty -> ChxDynamics
mkDynamicsFp Empty
a = Empty -> ChxDynamics
DynamicsFp Empty
a
-- | Smart constructor for 'DynamicsRf'
mkDynamicsRf :: Empty -> ChxDynamics
mkDynamicsRf :: Empty -> ChxDynamics
mkDynamicsRf Empty
a = Empty -> ChxDynamics
DynamicsRf Empty
a
-- | Smart constructor for 'DynamicsRfz'
mkDynamicsRfz :: Empty -> ChxDynamics
mkDynamicsRfz :: Empty -> ChxDynamics
mkDynamicsRfz Empty
a = Empty -> ChxDynamics
DynamicsRfz Empty
a
-- | Smart constructor for 'DynamicsSfz'
mkDynamicsSfz :: Empty -> ChxDynamics
mkDynamicsSfz :: Empty -> ChxDynamics
mkDynamicsSfz Empty
a = Empty -> ChxDynamics
DynamicsSfz Empty
a
-- | Smart constructor for 'DynamicsSffz'
mkDynamicsSffz :: Empty -> ChxDynamics
mkDynamicsSffz :: Empty -> ChxDynamics
mkDynamicsSffz Empty
a = Empty -> ChxDynamics
DynamicsSffz Empty
a
-- | Smart constructor for 'DynamicsFz'
mkDynamicsFz :: Empty -> ChxDynamics
mkDynamicsFz :: Empty -> ChxDynamics
mkDynamicsFz Empty
a = Empty -> ChxDynamics
DynamicsFz Empty
a
-- | Smart constructor for 'DynamicsN'
mkDynamicsN :: Empty -> ChxDynamics
mkDynamicsN :: Empty -> ChxDynamics
mkDynamicsN Empty
a = Empty -> ChxDynamics
DynamicsN Empty
a
-- | Smart constructor for 'DynamicsPf'
mkDynamicsPf :: Empty -> ChxDynamics
mkDynamicsPf :: Empty -> ChxDynamics
mkDynamicsPf Empty
a = Empty -> ChxDynamics
DynamicsPf Empty
a
-- | Smart constructor for 'DynamicsSfzp'
mkDynamicsSfzp :: Empty -> ChxDynamics
mkDynamicsSfzp :: Empty -> ChxDynamics
mkDynamicsSfzp Empty
a = Empty -> ChxDynamics
DynamicsSfzp Empty
a
-- | Smart constructor for 'DynamicsOtherDynamics'
mkDynamicsOtherDynamics :: OtherText -> ChxDynamics
mkDynamicsOtherDynamics :: OtherText -> ChxDynamics
mkDynamicsOtherDynamics OtherText
a = OtherText -> ChxDynamics
DynamicsOtherDynamics OtherText
a

-- | @encoding@ /(choice)/
data ChxEncoding = 
      EncodingEncodingDate {
          ChxEncoding -> YyyyMmDd
encodingEncodingDate :: YyyyMmDd -- ^ /encoding-date/ child element
       }
    | EncodingEncoder {
          ChxEncoding -> TypedText
encodingEncoder :: TypedText -- ^ /encoder/ child element
       }
    | EncodingSoftware {
          ChxEncoding -> String
encodingSoftware :: String -- ^ /software/ child element
       }
    | EncodingEncodingDescription {
          ChxEncoding -> String
encodingEncodingDescription :: String -- ^ /encoding-description/ child element
       }
    | EncodingSupports {
          ChxEncoding -> Supports
encodingSupports :: Supports -- ^ /supports/ child element
       }
    deriving (ChxEncoding -> ChxEncoding -> Bool
(ChxEncoding -> ChxEncoding -> Bool)
-> (ChxEncoding -> ChxEncoding -> Bool) -> Eq ChxEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxEncoding -> ChxEncoding -> Bool
$c/= :: ChxEncoding -> ChxEncoding -> Bool
== :: ChxEncoding -> ChxEncoding -> Bool
$c== :: ChxEncoding -> ChxEncoding -> Bool
Eq,Typeable,(forall x. ChxEncoding -> Rep ChxEncoding x)
-> (forall x. Rep ChxEncoding x -> ChxEncoding)
-> Generic ChxEncoding
forall x. Rep ChxEncoding x -> ChxEncoding
forall x. ChxEncoding -> Rep ChxEncoding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxEncoding x -> ChxEncoding
$cfrom :: forall x. ChxEncoding -> Rep ChxEncoding x
Generic,Int -> ChxEncoding -> ShowS
[ChxEncoding] -> ShowS
ChxEncoding -> String
(Int -> ChxEncoding -> ShowS)
-> (ChxEncoding -> String)
-> ([ChxEncoding] -> ShowS)
-> Show ChxEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxEncoding] -> ShowS
$cshowList :: [ChxEncoding] -> ShowS
show :: ChxEncoding -> String
$cshow :: ChxEncoding -> String
showsPrec :: Int -> ChxEncoding -> ShowS
$cshowsPrec :: Int -> ChxEncoding -> ShowS
Show)
instance EmitXml ChxEncoding where
    emitXml :: ChxEncoding -> XmlRep
emitXml (EncodingEncodingDate YyyyMmDd
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"encoding-date" Maybe String
forall a. Maybe a
Nothing) (YyyyMmDd -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml YyyyMmDd
a)])
    emitXml (EncodingEncoder TypedText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"encoder" Maybe String
forall a. Maybe a
Nothing) (TypedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TypedText
a)])
    emitXml (EncodingSoftware String
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"software" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)])
    emitXml (EncodingEncodingDescription String
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"encoding-description" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)])
    emitXml (EncodingSupports Supports
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"supports" Maybe String
forall a. Maybe a
Nothing) (Supports -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Supports
a)])
parseChxEncoding :: P.XParse ChxEncoding
parseChxEncoding :: XParse ChxEncoding
parseChxEncoding = 
      YyyyMmDd -> ChxEncoding
EncodingEncodingDate
        (YyyyMmDd -> ChxEncoding) -> XParse YyyyMmDd -> XParse ChxEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse YyyyMmDd -> XParse YyyyMmDd
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"encoding-date") (XParse String
P.xtext XParse String -> (String -> XParse YyyyMmDd) -> XParse YyyyMmDd
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse YyyyMmDd
parseYyyyMmDd))
      XParse ChxEncoding -> XParse ChxEncoding -> XParse ChxEncoding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypedText -> ChxEncoding
EncodingEncoder
        (TypedText -> ChxEncoding)
-> XParse TypedText -> XParse ChxEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse TypedText -> XParse TypedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"encoder") (XParse TypedText
parseTypedText))
      XParse ChxEncoding -> XParse ChxEncoding -> XParse ChxEncoding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ChxEncoding
EncodingSoftware
        (String -> ChxEncoding) -> XParse String -> XParse ChxEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"software") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
      XParse ChxEncoding -> XParse ChxEncoding -> XParse ChxEncoding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ChxEncoding
EncodingEncodingDescription
        (String -> ChxEncoding) -> XParse String -> XParse ChxEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"encoding-description") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
      XParse ChxEncoding -> XParse ChxEncoding -> XParse ChxEncoding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Supports -> ChxEncoding
EncodingSupports
        (Supports -> ChxEncoding) -> XParse Supports -> XParse ChxEncoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Supports -> XParse Supports
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"supports") (XParse Supports
parseSupports))

-- | Smart constructor for 'EncodingEncodingDate'
mkEncodingEncodingDate :: YyyyMmDd -> ChxEncoding
mkEncodingEncodingDate :: YyyyMmDd -> ChxEncoding
mkEncodingEncodingDate YyyyMmDd
a = YyyyMmDd -> ChxEncoding
EncodingEncodingDate YyyyMmDd
a
-- | Smart constructor for 'EncodingEncoder'
mkEncodingEncoder :: TypedText -> ChxEncoding
mkEncodingEncoder :: TypedText -> ChxEncoding
mkEncodingEncoder TypedText
a = TypedText -> ChxEncoding
EncodingEncoder TypedText
a
-- | Smart constructor for 'EncodingSoftware'
mkEncodingSoftware :: String -> ChxEncoding
mkEncodingSoftware :: String -> ChxEncoding
mkEncodingSoftware String
a = String -> ChxEncoding
EncodingSoftware String
a
-- | Smart constructor for 'EncodingEncodingDescription'
mkEncodingEncodingDescription :: String -> ChxEncoding
mkEncodingEncodingDescription :: String -> ChxEncoding
mkEncodingEncodingDescription String
a = String -> ChxEncoding
EncodingEncodingDescription String
a
-- | Smart constructor for 'EncodingSupports'
mkEncodingSupports :: Supports -> ChxEncoding
mkEncodingSupports :: Supports -> ChxEncoding
mkEncodingSupports Supports
a = Supports -> ChxEncoding
EncodingSupports Supports
a

-- | @full-note@ /(choice)/
data FullNote = 
      FullNotePitch {
          FullNote -> Pitch
fullNotePitch :: Pitch -- ^ /pitch/ child element
       }
    | FullNoteUnpitched {
          FullNote -> Unpitched
fullNoteUnpitched :: Unpitched -- ^ /unpitched/ child element
       }
    | FullNoteRest {
          FullNote -> Rest
fullNoteRest :: Rest -- ^ /rest/ child element
       }
    deriving (FullNote -> FullNote -> Bool
(FullNote -> FullNote -> Bool)
-> (FullNote -> FullNote -> Bool) -> Eq FullNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullNote -> FullNote -> Bool
$c/= :: FullNote -> FullNote -> Bool
== :: FullNote -> FullNote -> Bool
$c== :: FullNote -> FullNote -> Bool
Eq,Typeable,(forall x. FullNote -> Rep FullNote x)
-> (forall x. Rep FullNote x -> FullNote) -> Generic FullNote
forall x. Rep FullNote x -> FullNote
forall x. FullNote -> Rep FullNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FullNote x -> FullNote
$cfrom :: forall x. FullNote -> Rep FullNote x
Generic,Int -> FullNote -> ShowS
[FullNote] -> ShowS
FullNote -> String
(Int -> FullNote -> ShowS)
-> (FullNote -> String) -> ([FullNote] -> ShowS) -> Show FullNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullNote] -> ShowS
$cshowList :: [FullNote] -> ShowS
show :: FullNote -> String
$cshow :: FullNote -> String
showsPrec :: Int -> FullNote -> ShowS
$cshowsPrec :: Int -> FullNote -> ShowS
Show)
instance EmitXml FullNote where
    emitXml :: FullNote -> XmlRep
emitXml (FullNotePitch Pitch
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pitch" Maybe String
forall a. Maybe a
Nothing) (Pitch -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Pitch
a)])
    emitXml (FullNoteUnpitched Unpitched
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"unpitched" Maybe String
forall a. Maybe a
Nothing) (Unpitched -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Unpitched
a)])
    emitXml (FullNoteRest Rest
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"rest" Maybe String
forall a. Maybe a
Nothing) (Rest -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Rest
a)])
parseFullNote :: P.XParse FullNote
parseFullNote :: XParse FullNote
parseFullNote = 
      Pitch -> FullNote
FullNotePitch
        (Pitch -> FullNote) -> XParse Pitch -> XParse FullNote
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Pitch -> XParse Pitch
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pitch") (XParse Pitch
parsePitch))
      XParse FullNote -> XParse FullNote -> XParse FullNote
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Unpitched -> FullNote
FullNoteUnpitched
        (Unpitched -> FullNote) -> XParse Unpitched -> XParse FullNote
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Unpitched -> XParse Unpitched
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"unpitched") (XParse Unpitched
parseUnpitched))
      XParse FullNote -> XParse FullNote -> XParse FullNote
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Rest -> FullNote
FullNoteRest
        (Rest -> FullNote) -> XParse Rest -> XParse FullNote
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Rest -> XParse Rest
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"rest") (XParse Rest
parseRest))

-- | Smart constructor for 'FullNotePitch'
mkFullNotePitch :: Pitch -> FullNote
mkFullNotePitch :: Pitch -> FullNote
mkFullNotePitch Pitch
a = Pitch -> FullNote
FullNotePitch Pitch
a
-- | Smart constructor for 'FullNoteUnpitched'
mkFullNoteUnpitched :: Unpitched -> FullNote
mkFullNoteUnpitched :: Unpitched -> FullNote
mkFullNoteUnpitched Unpitched
a = Unpitched -> FullNote
FullNoteUnpitched Unpitched
a
-- | Smart constructor for 'FullNoteRest'
mkFullNoteRest :: Rest -> FullNote
mkFullNoteRest :: Rest -> FullNote
mkFullNoteRest Rest
a = Rest -> FullNote
FullNoteRest Rest
a

-- | @harmonic@ /(choice)/
data ChxHarmonic = 
      HarmonicNatural {
          ChxHarmonic -> Empty
harmonicNatural :: Empty -- ^ /natural/ child element
       }
    | HarmonicArtificial {
          ChxHarmonic -> Empty
harmonicArtificial :: Empty -- ^ /artificial/ child element
       }
    deriving (ChxHarmonic -> ChxHarmonic -> Bool
(ChxHarmonic -> ChxHarmonic -> Bool)
-> (ChxHarmonic -> ChxHarmonic -> Bool) -> Eq ChxHarmonic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxHarmonic -> ChxHarmonic -> Bool
$c/= :: ChxHarmonic -> ChxHarmonic -> Bool
== :: ChxHarmonic -> ChxHarmonic -> Bool
$c== :: ChxHarmonic -> ChxHarmonic -> Bool
Eq,Typeable,(forall x. ChxHarmonic -> Rep ChxHarmonic x)
-> (forall x. Rep ChxHarmonic x -> ChxHarmonic)
-> Generic ChxHarmonic
forall x. Rep ChxHarmonic x -> ChxHarmonic
forall x. ChxHarmonic -> Rep ChxHarmonic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxHarmonic x -> ChxHarmonic
$cfrom :: forall x. ChxHarmonic -> Rep ChxHarmonic x
Generic,Int -> ChxHarmonic -> ShowS
[ChxHarmonic] -> ShowS
ChxHarmonic -> String
(Int -> ChxHarmonic -> ShowS)
-> (ChxHarmonic -> String)
-> ([ChxHarmonic] -> ShowS)
-> Show ChxHarmonic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxHarmonic] -> ShowS
$cshowList :: [ChxHarmonic] -> ShowS
show :: ChxHarmonic -> String
$cshow :: ChxHarmonic -> String
showsPrec :: Int -> ChxHarmonic -> ShowS
$cshowsPrec :: Int -> ChxHarmonic -> ShowS
Show)
instance EmitXml ChxHarmonic where
    emitXml :: ChxHarmonic -> XmlRep
emitXml (HarmonicNatural Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"natural" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (HarmonicArtificial Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"artificial" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
parseChxHarmonic :: P.XParse ChxHarmonic
parseChxHarmonic :: XParse ChxHarmonic
parseChxHarmonic = 
      Empty -> ChxHarmonic
HarmonicNatural
        (Empty -> ChxHarmonic) -> XParse Empty -> XParse ChxHarmonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"natural") (XParse Empty
parseEmpty))
      XParse ChxHarmonic -> XParse ChxHarmonic -> XParse ChxHarmonic
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxHarmonic
HarmonicArtificial
        (Empty -> ChxHarmonic) -> XParse Empty -> XParse ChxHarmonic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"artificial") (XParse Empty
parseEmpty))

-- | Smart constructor for 'HarmonicNatural'
mkHarmonicNatural :: Empty -> ChxHarmonic
mkHarmonicNatural :: Empty -> ChxHarmonic
mkHarmonicNatural Empty
a = Empty -> ChxHarmonic
HarmonicNatural Empty
a
-- | Smart constructor for 'HarmonicArtificial'
mkHarmonicArtificial :: Empty -> ChxHarmonic
mkHarmonicArtificial :: Empty -> ChxHarmonic
mkHarmonicArtificial Empty
a = Empty -> ChxHarmonic
HarmonicArtificial Empty
a

-- | @harmonic@ /(choice)/

-- mangled: 1
data ChxHarmonic1 = 
      HarmonicBasePitch {
          ChxHarmonic1 -> Empty
harmonicBasePitch :: Empty -- ^ /base-pitch/ child element
       }
    | HarmonicTouchingPitch {
          ChxHarmonic1 -> Empty
harmonicTouchingPitch :: Empty -- ^ /touching-pitch/ child element
       }
    | HarmonicSoundingPitch {
          ChxHarmonic1 -> Empty
harmonicSoundingPitch :: Empty -- ^ /sounding-pitch/ child element
       }
    deriving (ChxHarmonic1 -> ChxHarmonic1 -> Bool
(ChxHarmonic1 -> ChxHarmonic1 -> Bool)
-> (ChxHarmonic1 -> ChxHarmonic1 -> Bool) -> Eq ChxHarmonic1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxHarmonic1 -> ChxHarmonic1 -> Bool
$c/= :: ChxHarmonic1 -> ChxHarmonic1 -> Bool
== :: ChxHarmonic1 -> ChxHarmonic1 -> Bool
$c== :: ChxHarmonic1 -> ChxHarmonic1 -> Bool
Eq,Typeable,(forall x. ChxHarmonic1 -> Rep ChxHarmonic1 x)
-> (forall x. Rep ChxHarmonic1 x -> ChxHarmonic1)
-> Generic ChxHarmonic1
forall x. Rep ChxHarmonic1 x -> ChxHarmonic1
forall x. ChxHarmonic1 -> Rep ChxHarmonic1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxHarmonic1 x -> ChxHarmonic1
$cfrom :: forall x. ChxHarmonic1 -> Rep ChxHarmonic1 x
Generic,Int -> ChxHarmonic1 -> ShowS
[ChxHarmonic1] -> ShowS
ChxHarmonic1 -> String
(Int -> ChxHarmonic1 -> ShowS)
-> (ChxHarmonic1 -> String)
-> ([ChxHarmonic1] -> ShowS)
-> Show ChxHarmonic1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxHarmonic1] -> ShowS
$cshowList :: [ChxHarmonic1] -> ShowS
show :: ChxHarmonic1 -> String
$cshow :: ChxHarmonic1 -> String
showsPrec :: Int -> ChxHarmonic1 -> ShowS
$cshowsPrec :: Int -> ChxHarmonic1 -> ShowS
Show)
instance EmitXml ChxHarmonic1 where
    emitXml :: ChxHarmonic1 -> XmlRep
emitXml (HarmonicBasePitch Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"base-pitch" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (HarmonicTouchingPitch Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"touching-pitch" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (HarmonicSoundingPitch Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sounding-pitch" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
parseChxHarmonic1 :: P.XParse ChxHarmonic1
parseChxHarmonic1 :: XParse ChxHarmonic1
parseChxHarmonic1 = 
      Empty -> ChxHarmonic1
HarmonicBasePitch
        (Empty -> ChxHarmonic1) -> XParse Empty -> XParse ChxHarmonic1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"base-pitch") (XParse Empty
parseEmpty))
      XParse ChxHarmonic1 -> XParse ChxHarmonic1 -> XParse ChxHarmonic1
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxHarmonic1
HarmonicTouchingPitch
        (Empty -> ChxHarmonic1) -> XParse Empty -> XParse ChxHarmonic1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"touching-pitch") (XParse Empty
parseEmpty))
      XParse ChxHarmonic1 -> XParse ChxHarmonic1 -> XParse ChxHarmonic1
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxHarmonic1
HarmonicSoundingPitch
        (Empty -> ChxHarmonic1) -> XParse Empty -> XParse ChxHarmonic1
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sounding-pitch") (XParse Empty
parseEmpty))

-- | Smart constructor for 'HarmonicBasePitch'
mkHarmonicBasePitch :: Empty -> ChxHarmonic1
mkHarmonicBasePitch :: Empty -> ChxHarmonic1
mkHarmonicBasePitch Empty
a = Empty -> ChxHarmonic1
HarmonicBasePitch Empty
a
-- | Smart constructor for 'HarmonicTouchingPitch'
mkHarmonicTouchingPitch :: Empty -> ChxHarmonic1
mkHarmonicTouchingPitch :: Empty -> ChxHarmonic1
mkHarmonicTouchingPitch Empty
a = Empty -> ChxHarmonic1
HarmonicTouchingPitch Empty
a
-- | Smart constructor for 'HarmonicSoundingPitch'
mkHarmonicSoundingPitch :: Empty -> ChxHarmonic1
mkHarmonicSoundingPitch :: Empty -> ChxHarmonic1
mkHarmonicSoundingPitch Empty
a = Empty -> ChxHarmonic1
HarmonicSoundingPitch Empty
a

-- | @harmony-chord@ /(choice)/
data ChxHarmonyChord = 
      HarmonyChordRoot {
          ChxHarmonyChord -> Root
harmonyChordRoot :: Root -- ^ /root/ child element
       }
    | HarmonyChordFunction {
          ChxHarmonyChord -> StyleText
harmonyChordFunction :: StyleText -- ^ /function/ child element
       }
    deriving (ChxHarmonyChord -> ChxHarmonyChord -> Bool
(ChxHarmonyChord -> ChxHarmonyChord -> Bool)
-> (ChxHarmonyChord -> ChxHarmonyChord -> Bool)
-> Eq ChxHarmonyChord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxHarmonyChord -> ChxHarmonyChord -> Bool
$c/= :: ChxHarmonyChord -> ChxHarmonyChord -> Bool
== :: ChxHarmonyChord -> ChxHarmonyChord -> Bool
$c== :: ChxHarmonyChord -> ChxHarmonyChord -> Bool
Eq,Typeable,(forall x. ChxHarmonyChord -> Rep ChxHarmonyChord x)
-> (forall x. Rep ChxHarmonyChord x -> ChxHarmonyChord)
-> Generic ChxHarmonyChord
forall x. Rep ChxHarmonyChord x -> ChxHarmonyChord
forall x. ChxHarmonyChord -> Rep ChxHarmonyChord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxHarmonyChord x -> ChxHarmonyChord
$cfrom :: forall x. ChxHarmonyChord -> Rep ChxHarmonyChord x
Generic,Int -> ChxHarmonyChord -> ShowS
[ChxHarmonyChord] -> ShowS
ChxHarmonyChord -> String
(Int -> ChxHarmonyChord -> ShowS)
-> (ChxHarmonyChord -> String)
-> ([ChxHarmonyChord] -> ShowS)
-> Show ChxHarmonyChord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxHarmonyChord] -> ShowS
$cshowList :: [ChxHarmonyChord] -> ShowS
show :: ChxHarmonyChord -> String
$cshow :: ChxHarmonyChord -> String
showsPrec :: Int -> ChxHarmonyChord -> ShowS
$cshowsPrec :: Int -> ChxHarmonyChord -> ShowS
Show)
instance EmitXml ChxHarmonyChord where
    emitXml :: ChxHarmonyChord -> XmlRep
emitXml (HarmonyChordRoot Root
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"root" Maybe String
forall a. Maybe a
Nothing) (Root -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Root
a)])
    emitXml (HarmonyChordFunction StyleText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"function" Maybe String
forall a. Maybe a
Nothing) (StyleText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StyleText
a)])
parseChxHarmonyChord :: P.XParse ChxHarmonyChord
parseChxHarmonyChord :: XParse ChxHarmonyChord
parseChxHarmonyChord = 
      Root -> ChxHarmonyChord
HarmonyChordRoot
        (Root -> ChxHarmonyChord) -> XParse Root -> XParse ChxHarmonyChord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Root -> XParse Root
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"root") (XParse Root
parseRoot))
      XParse ChxHarmonyChord
-> XParse ChxHarmonyChord -> XParse ChxHarmonyChord
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StyleText -> ChxHarmonyChord
HarmonyChordFunction
        (StyleText -> ChxHarmonyChord)
-> XParse StyleText -> XParse ChxHarmonyChord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse StyleText -> XParse StyleText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"function") (XParse StyleText
parseStyleText))

-- | Smart constructor for 'HarmonyChordRoot'
mkHarmonyChordRoot :: Root -> ChxHarmonyChord
mkHarmonyChordRoot :: Root -> ChxHarmonyChord
mkHarmonyChordRoot Root
a = Root -> ChxHarmonyChord
HarmonyChordRoot Root
a
-- | Smart constructor for 'HarmonyChordFunction'
mkHarmonyChordFunction :: StyleText -> ChxHarmonyChord
mkHarmonyChordFunction :: StyleText -> ChxHarmonyChord
mkHarmonyChordFunction StyleText
a = StyleText -> ChxHarmonyChord
HarmonyChordFunction StyleText
a

-- | @key@ /(choice)/
data ChxKey = 
      KeyTraditionalKey {
          ChxKey -> TraditionalKey
keyTraditionalKey :: TraditionalKey
       }
    | KeyNonTraditionalKey {
          ChxKey -> [NonTraditionalKey]
keyNonTraditionalKey :: [NonTraditionalKey]
       }
    deriving (ChxKey -> ChxKey -> Bool
(ChxKey -> ChxKey -> Bool)
-> (ChxKey -> ChxKey -> Bool) -> Eq ChxKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxKey -> ChxKey -> Bool
$c/= :: ChxKey -> ChxKey -> Bool
== :: ChxKey -> ChxKey -> Bool
$c== :: ChxKey -> ChxKey -> Bool
Eq,Typeable,(forall x. ChxKey -> Rep ChxKey x)
-> (forall x. Rep ChxKey x -> ChxKey) -> Generic ChxKey
forall x. Rep ChxKey x -> ChxKey
forall x. ChxKey -> Rep ChxKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxKey x -> ChxKey
$cfrom :: forall x. ChxKey -> Rep ChxKey x
Generic,Int -> ChxKey -> ShowS
[ChxKey] -> ShowS
ChxKey -> String
(Int -> ChxKey -> ShowS)
-> (ChxKey -> String) -> ([ChxKey] -> ShowS) -> Show ChxKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxKey] -> ShowS
$cshowList :: [ChxKey] -> ShowS
show :: ChxKey -> String
$cshow :: ChxKey -> String
showsPrec :: Int -> ChxKey -> ShowS
$cshowsPrec :: Int -> ChxKey -> ShowS
Show)
instance EmitXml ChxKey where
    emitXml :: ChxKey -> XmlRep
emitXml (KeyTraditionalKey TraditionalKey
a) =
      [XmlRep] -> XmlRep
XReps [TraditionalKey -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TraditionalKey
a]
    emitXml (KeyNonTraditionalKey [NonTraditionalKey]
a) =
      [XmlRep] -> XmlRep
XReps [[NonTraditionalKey] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [NonTraditionalKey]
a]
parseChxKey :: P.XParse ChxKey
parseChxKey :: XParse ChxKey
parseChxKey = 
      TraditionalKey -> ChxKey
KeyTraditionalKey
        (TraditionalKey -> ChxKey)
-> XParse TraditionalKey -> XParse ChxKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TraditionalKey
parseTraditionalKey
      XParse ChxKey -> XParse ChxKey -> XParse ChxKey
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [NonTraditionalKey] -> ChxKey
KeyNonTraditionalKey
        ([NonTraditionalKey] -> ChxKey)
-> XParse [NonTraditionalKey] -> XParse ChxKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse NonTraditionalKey -> XParse [NonTraditionalKey]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse NonTraditionalKey
parseNonTraditionalKey)

-- | Smart constructor for 'KeyTraditionalKey'
mkKeyTraditionalKey :: TraditionalKey -> ChxKey
mkKeyTraditionalKey :: TraditionalKey -> ChxKey
mkKeyTraditionalKey TraditionalKey
a = TraditionalKey -> ChxKey
KeyTraditionalKey TraditionalKey
a
-- | Smart constructor for 'KeyNonTraditionalKey'
mkKeyNonTraditionalKey :: ChxKey
mkKeyNonTraditionalKey :: ChxKey
mkKeyNonTraditionalKey = [NonTraditionalKey] -> ChxKey
KeyNonTraditionalKey []

-- | @lyric@ /(choice)/
data ChxLyric = 
      LyricSyllabic {
          ChxLyric -> Maybe Syllabic
lyricSyllabic :: (Maybe Syllabic) -- ^ /syllabic/ child element
        , ChxLyric -> TextElementData
lyricText :: TextElementData -- ^ /text/ child element
        , ChxLyric -> [SeqLyric]
chxlyricLyric :: [SeqLyric]
        , ChxLyric -> Maybe Extend
lyricExtend :: (Maybe Extend) -- ^ /extend/ child element
       }
    | LyricExtend {
          ChxLyric -> Extend
lyricExtend1 :: Extend -- ^ /extend/ child element
       }
    | LyricLaughing {
          ChxLyric -> Empty
lyricLaughing :: Empty -- ^ /laughing/ child element
       }
    | LyricHumming {
          ChxLyric -> Empty
lyricHumming :: Empty -- ^ /humming/ child element
       }
    deriving (ChxLyric -> ChxLyric -> Bool
(ChxLyric -> ChxLyric -> Bool)
-> (ChxLyric -> ChxLyric -> Bool) -> Eq ChxLyric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxLyric -> ChxLyric -> Bool
$c/= :: ChxLyric -> ChxLyric -> Bool
== :: ChxLyric -> ChxLyric -> Bool
$c== :: ChxLyric -> ChxLyric -> Bool
Eq,Typeable,(forall x. ChxLyric -> Rep ChxLyric x)
-> (forall x. Rep ChxLyric x -> ChxLyric) -> Generic ChxLyric
forall x. Rep ChxLyric x -> ChxLyric
forall x. ChxLyric -> Rep ChxLyric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxLyric x -> ChxLyric
$cfrom :: forall x. ChxLyric -> Rep ChxLyric x
Generic,Int -> ChxLyric -> ShowS
[ChxLyric] -> ShowS
ChxLyric -> String
(Int -> ChxLyric -> ShowS)
-> (ChxLyric -> String) -> ([ChxLyric] -> ShowS) -> Show ChxLyric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxLyric] -> ShowS
$cshowList :: [ChxLyric] -> ShowS
show :: ChxLyric -> String
$cshow :: ChxLyric -> String
showsPrec :: Int -> ChxLyric -> ShowS
$cshowsPrec :: Int -> ChxLyric -> ShowS
Show)
instance EmitXml ChxLyric where
    emitXml :: ChxLyric -> XmlRep
emitXml (LyricSyllabic Maybe Syllabic
a TextElementData
b [SeqLyric]
c Maybe Extend
d) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Syllabic -> XmlRep) -> Maybe Syllabic -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"syllabic" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Syllabic -> XmlRep) -> Syllabic -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Syllabic -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Syllabic
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing) (TextElementData -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TextElementData
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [[SeqLyric] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [SeqLyric]
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Extend -> XmlRep) -> Maybe Extend -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"extend" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Extend -> XmlRep) -> Extend -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Extend -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Extend
d])
    emitXml (LyricExtend Extend
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"extend" Maybe String
forall a. Maybe a
Nothing) (Extend -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Extend
a)])
    emitXml (LyricLaughing Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"laughing" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (LyricHumming Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"humming" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
parseChxLyric :: P.XParse ChxLyric
parseChxLyric :: XParse ChxLyric
parseChxLyric = 
      Maybe Syllabic
-> TextElementData -> [SeqLyric] -> Maybe Extend -> ChxLyric
LyricSyllabic
        (Maybe Syllabic
 -> TextElementData -> [SeqLyric] -> Maybe Extend -> ChxLyric)
-> XParse (Maybe Syllabic)
-> XParse
     (TextElementData -> [SeqLyric] -> Maybe Extend -> ChxLyric)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Syllabic -> XParse (Maybe Syllabic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Syllabic -> XParse Syllabic
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"syllabic") (XParse String
P.xtext XParse String -> (String -> XParse Syllabic) -> XParse Syllabic
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Syllabic
parseSyllabic))
        XParse (TextElementData -> [SeqLyric] -> Maybe Extend -> ChxLyric)
-> XParse TextElementData
-> XParse ([SeqLyric] -> Maybe Extend -> ChxLyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse TextElementData -> XParse TextElementData
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"text") (XParse TextElementData
parseTextElementData))
        XParse ([SeqLyric] -> Maybe Extend -> ChxLyric)
-> XParse [SeqLyric] -> XParse (Maybe Extend -> ChxLyric)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqLyric -> XParse [SeqLyric]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse SeqLyric
parseSeqLyric)
        XParse (Maybe Extend -> ChxLyric)
-> XParse (Maybe Extend) -> XParse ChxLyric
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Extend -> XParse (Maybe Extend)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Extend -> XParse Extend
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"extend") (XParse Extend
parseExtend))
      XParse ChxLyric -> XParse ChxLyric -> XParse ChxLyric
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Extend -> ChxLyric
LyricExtend
        (Extend -> ChxLyric) -> XParse Extend -> XParse ChxLyric
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Extend -> XParse Extend
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"extend") (XParse Extend
parseExtend))
      XParse ChxLyric -> XParse ChxLyric -> XParse ChxLyric
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxLyric
LyricLaughing
        (Empty -> ChxLyric) -> XParse Empty -> XParse ChxLyric
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"laughing") (XParse Empty
parseEmpty))
      XParse ChxLyric -> XParse ChxLyric -> XParse ChxLyric
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxLyric
LyricHumming
        (Empty -> ChxLyric) -> XParse Empty -> XParse ChxLyric
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"humming") (XParse Empty
parseEmpty))

-- | Smart constructor for 'LyricSyllabic'
mkLyricSyllabic :: TextElementData -> ChxLyric
mkLyricSyllabic :: TextElementData -> ChxLyric
mkLyricSyllabic TextElementData
b = Maybe Syllabic
-> TextElementData -> [SeqLyric] -> Maybe Extend -> ChxLyric
LyricSyllabic Maybe Syllabic
forall a. Maybe a
Nothing TextElementData
b [] Maybe Extend
forall a. Maybe a
Nothing
-- | Smart constructor for 'LyricExtend'
mkLyricExtend :: Extend -> ChxLyric
mkLyricExtend :: Extend -> ChxLyric
mkLyricExtend Extend
a = Extend -> ChxLyric
LyricExtend Extend
a
-- | Smart constructor for 'LyricLaughing'
mkLyricLaughing :: Empty -> ChxLyric
mkLyricLaughing :: Empty -> ChxLyric
mkLyricLaughing Empty
a = Empty -> ChxLyric
LyricLaughing Empty
a
-- | Smart constructor for 'LyricHumming'
mkLyricHumming :: Empty -> ChxLyric
mkLyricHumming :: Empty -> ChxLyric
mkLyricHumming Empty
a = Empty -> ChxLyric
LyricHumming Empty
a

-- | @measure-style@ /(choice)/
data ChxMeasureStyle = 
      MeasureStyleMultipleRest {
          ChxMeasureStyle -> MultipleRest
measureStyleMultipleRest :: MultipleRest -- ^ /multiple-rest/ child element
       }
    | MeasureStyleMeasureRepeat {
          ChxMeasureStyle -> MeasureRepeat
measureStyleMeasureRepeat :: MeasureRepeat -- ^ /measure-repeat/ child element
       }
    | MeasureStyleBeatRepeat {
          ChxMeasureStyle -> BeatRepeat
measureStyleBeatRepeat :: BeatRepeat -- ^ /beat-repeat/ child element
       }
    | MeasureStyleSlash {
          ChxMeasureStyle -> CmpSlash
measureStyleSlash :: CmpSlash -- ^ /slash/ child element
       }
    deriving (ChxMeasureStyle -> ChxMeasureStyle -> Bool
(ChxMeasureStyle -> ChxMeasureStyle -> Bool)
-> (ChxMeasureStyle -> ChxMeasureStyle -> Bool)
-> Eq ChxMeasureStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxMeasureStyle -> ChxMeasureStyle -> Bool
$c/= :: ChxMeasureStyle -> ChxMeasureStyle -> Bool
== :: ChxMeasureStyle -> ChxMeasureStyle -> Bool
$c== :: ChxMeasureStyle -> ChxMeasureStyle -> Bool
Eq,Typeable,(forall x. ChxMeasureStyle -> Rep ChxMeasureStyle x)
-> (forall x. Rep ChxMeasureStyle x -> ChxMeasureStyle)
-> Generic ChxMeasureStyle
forall x. Rep ChxMeasureStyle x -> ChxMeasureStyle
forall x. ChxMeasureStyle -> Rep ChxMeasureStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxMeasureStyle x -> ChxMeasureStyle
$cfrom :: forall x. ChxMeasureStyle -> Rep ChxMeasureStyle x
Generic,Int -> ChxMeasureStyle -> ShowS
[ChxMeasureStyle] -> ShowS
ChxMeasureStyle -> String
(Int -> ChxMeasureStyle -> ShowS)
-> (ChxMeasureStyle -> String)
-> ([ChxMeasureStyle] -> ShowS)
-> Show ChxMeasureStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxMeasureStyle] -> ShowS
$cshowList :: [ChxMeasureStyle] -> ShowS
show :: ChxMeasureStyle -> String
$cshow :: ChxMeasureStyle -> String
showsPrec :: Int -> ChxMeasureStyle -> ShowS
$cshowsPrec :: Int -> ChxMeasureStyle -> ShowS
Show)
instance EmitXml ChxMeasureStyle where
    emitXml :: ChxMeasureStyle -> XmlRep
emitXml (MeasureStyleMultipleRest MultipleRest
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"multiple-rest" Maybe String
forall a. Maybe a
Nothing) (MultipleRest -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MultipleRest
a)])
    emitXml (MeasureStyleMeasureRepeat MeasureRepeat
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"measure-repeat" Maybe String
forall a. Maybe a
Nothing) (MeasureRepeat -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml MeasureRepeat
a)])
    emitXml (MeasureStyleBeatRepeat BeatRepeat
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-repeat" Maybe String
forall a. Maybe a
Nothing) (BeatRepeat -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeatRepeat
a)])
    emitXml (MeasureStyleSlash CmpSlash
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"slash" Maybe String
forall a. Maybe a
Nothing) (CmpSlash -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CmpSlash
a)])
parseChxMeasureStyle :: P.XParse ChxMeasureStyle
parseChxMeasureStyle :: XParse ChxMeasureStyle
parseChxMeasureStyle = 
      MultipleRest -> ChxMeasureStyle
MeasureStyleMultipleRest
        (MultipleRest -> ChxMeasureStyle)
-> XParse MultipleRest -> XParse ChxMeasureStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse MultipleRest -> XParse MultipleRest
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"multiple-rest") (XParse MultipleRest
parseMultipleRest))
      XParse ChxMeasureStyle
-> XParse ChxMeasureStyle -> XParse ChxMeasureStyle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MeasureRepeat -> ChxMeasureStyle
MeasureStyleMeasureRepeat
        (MeasureRepeat -> ChxMeasureStyle)
-> XParse MeasureRepeat -> XParse ChxMeasureStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse MeasureRepeat -> XParse MeasureRepeat
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"measure-repeat") (XParse MeasureRepeat
parseMeasureRepeat))
      XParse ChxMeasureStyle
-> XParse ChxMeasureStyle -> XParse ChxMeasureStyle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BeatRepeat -> ChxMeasureStyle
MeasureStyleBeatRepeat
        (BeatRepeat -> ChxMeasureStyle)
-> XParse BeatRepeat -> XParse ChxMeasureStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse BeatRepeat -> XParse BeatRepeat
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-repeat") (XParse BeatRepeat
parseBeatRepeat))
      XParse ChxMeasureStyle
-> XParse ChxMeasureStyle -> XParse ChxMeasureStyle
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CmpSlash -> ChxMeasureStyle
MeasureStyleSlash
        (CmpSlash -> ChxMeasureStyle)
-> XParse CmpSlash -> XParse ChxMeasureStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse CmpSlash -> XParse CmpSlash
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"slash") (XParse CmpSlash
parseCmpSlash))

-- | Smart constructor for 'MeasureStyleMultipleRest'
mkMeasureStyleMultipleRest :: MultipleRest -> ChxMeasureStyle
mkMeasureStyleMultipleRest :: MultipleRest -> ChxMeasureStyle
mkMeasureStyleMultipleRest MultipleRest
a = MultipleRest -> ChxMeasureStyle
MeasureStyleMultipleRest MultipleRest
a
-- | Smart constructor for 'MeasureStyleMeasureRepeat'
mkMeasureStyleMeasureRepeat :: MeasureRepeat -> ChxMeasureStyle
mkMeasureStyleMeasureRepeat :: MeasureRepeat -> ChxMeasureStyle
mkMeasureStyleMeasureRepeat MeasureRepeat
a = MeasureRepeat -> ChxMeasureStyle
MeasureStyleMeasureRepeat MeasureRepeat
a
-- | Smart constructor for 'MeasureStyleBeatRepeat'
mkMeasureStyleBeatRepeat :: BeatRepeat -> ChxMeasureStyle
mkMeasureStyleBeatRepeat :: BeatRepeat -> ChxMeasureStyle
mkMeasureStyleBeatRepeat BeatRepeat
a = BeatRepeat -> ChxMeasureStyle
MeasureStyleBeatRepeat BeatRepeat
a
-- | Smart constructor for 'MeasureStyleSlash'
mkMeasureStyleSlash :: CmpSlash -> ChxMeasureStyle
mkMeasureStyleSlash :: CmpSlash -> ChxMeasureStyle
mkMeasureStyleSlash CmpSlash
a = CmpSlash -> ChxMeasureStyle
MeasureStyleSlash CmpSlash
a

-- | @metronome@ /(choice)/
data ChxMetronome0 = 
      MetronomePerMinute {
          ChxMetronome0 -> PerMinute
metronomePerMinute :: PerMinute -- ^ /per-minute/ child element
       }
    | MetronomeBeatUnit {
          ChxMetronome0 -> BeatUnit
metronomeBeatUnit :: BeatUnit
        , ChxMetronome0 -> [BeatUnitTied]
metronomeBeatUnitTied :: [BeatUnitTied] -- ^ /beat-unit-tied/ child element
       }
    deriving (ChxMetronome0 -> ChxMetronome0 -> Bool
(ChxMetronome0 -> ChxMetronome0 -> Bool)
-> (ChxMetronome0 -> ChxMetronome0 -> Bool) -> Eq ChxMetronome0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxMetronome0 -> ChxMetronome0 -> Bool
$c/= :: ChxMetronome0 -> ChxMetronome0 -> Bool
== :: ChxMetronome0 -> ChxMetronome0 -> Bool
$c== :: ChxMetronome0 -> ChxMetronome0 -> Bool
Eq,Typeable,(forall x. ChxMetronome0 -> Rep ChxMetronome0 x)
-> (forall x. Rep ChxMetronome0 x -> ChxMetronome0)
-> Generic ChxMetronome0
forall x. Rep ChxMetronome0 x -> ChxMetronome0
forall x. ChxMetronome0 -> Rep ChxMetronome0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxMetronome0 x -> ChxMetronome0
$cfrom :: forall x. ChxMetronome0 -> Rep ChxMetronome0 x
Generic,Int -> ChxMetronome0 -> ShowS
[ChxMetronome0] -> ShowS
ChxMetronome0 -> String
(Int -> ChxMetronome0 -> ShowS)
-> (ChxMetronome0 -> String)
-> ([ChxMetronome0] -> ShowS)
-> Show ChxMetronome0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxMetronome0] -> ShowS
$cshowList :: [ChxMetronome0] -> ShowS
show :: ChxMetronome0 -> String
$cshow :: ChxMetronome0 -> String
showsPrec :: Int -> ChxMetronome0 -> ShowS
$cshowsPrec :: Int -> ChxMetronome0 -> ShowS
Show)
instance EmitXml ChxMetronome0 where
    emitXml :: ChxMetronome0 -> XmlRep
emitXml (MetronomePerMinute PerMinute
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"per-minute" Maybe String
forall a. Maybe a
Nothing) (PerMinute -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PerMinute
a)])
    emitXml (MetronomeBeatUnit BeatUnit
a [BeatUnitTied]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([BeatUnit -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeatUnit
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (BeatUnitTied -> XmlRep) -> [BeatUnitTied] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-unit-tied" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (BeatUnitTied -> XmlRep) -> BeatUnitTied -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BeatUnitTied -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [BeatUnitTied]
b)
parseChxMetronome0 :: P.XParse ChxMetronome0
parseChxMetronome0 :: XParse ChxMetronome0
parseChxMetronome0 = 
      PerMinute -> ChxMetronome0
MetronomePerMinute
        (PerMinute -> ChxMetronome0)
-> XParse PerMinute -> XParse ChxMetronome0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PerMinute -> XParse PerMinute
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"per-minute") (XParse PerMinute
parsePerMinute))
      XParse ChxMetronome0
-> XParse ChxMetronome0 -> XParse ChxMetronome0
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BeatUnit -> [BeatUnitTied] -> ChxMetronome0
MetronomeBeatUnit
        (BeatUnit -> [BeatUnitTied] -> ChxMetronome0)
-> XParse BeatUnit -> XParse ([BeatUnitTied] -> ChxMetronome0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse BeatUnit
parseBeatUnit
        XParse ([BeatUnitTied] -> ChxMetronome0)
-> XParse [BeatUnitTied] -> XParse ChxMetronome0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BeatUnitTied -> XParse [BeatUnitTied]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse BeatUnitTied -> XParse BeatUnitTied
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-unit-tied") (XParse BeatUnitTied
parseBeatUnitTied))

-- | Smart constructor for 'MetronomePerMinute'
mkMetronomePerMinute :: PerMinute -> ChxMetronome0
mkMetronomePerMinute :: PerMinute -> ChxMetronome0
mkMetronomePerMinute PerMinute
a = PerMinute -> ChxMetronome0
MetronomePerMinute PerMinute
a
-- | Smart constructor for 'MetronomeBeatUnit'
mkMetronomeBeatUnit :: BeatUnit -> ChxMetronome0
mkMetronomeBeatUnit :: BeatUnit -> ChxMetronome0
mkMetronomeBeatUnit BeatUnit
a = BeatUnit -> [BeatUnitTied] -> ChxMetronome0
MetronomeBeatUnit BeatUnit
a []

-- | @metronome@ /(choice)/

-- mangled: 1
data ChxMetronome = 
      ChxMetronomeBeatUnit {
          ChxMetronome -> BeatUnit
chxmetronomeBeatUnit :: BeatUnit
        , ChxMetronome -> [BeatUnitTied]
chxmetronomeBeatUnitTied :: [BeatUnitTied] -- ^ /beat-unit-tied/ child element
        , ChxMetronome -> ChxMetronome0
chxmetronomeMetronome :: ChxMetronome0
       }
    | MetronomeMetronomeArrows {
          ChxMetronome -> Maybe Empty
metronomeMetronomeArrows :: (Maybe Empty) -- ^ /metronome-arrows/ child element
        , ChxMetronome -> [MetronomeNote]
metronomeMetronomeNote :: [MetronomeNote] -- ^ /metronome-note/ child element
        , ChxMetronome -> Maybe SeqMetronome
metronomeMetronome1 :: (Maybe SeqMetronome)
       }
    deriving (ChxMetronome -> ChxMetronome -> Bool
(ChxMetronome -> ChxMetronome -> Bool)
-> (ChxMetronome -> ChxMetronome -> Bool) -> Eq ChxMetronome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxMetronome -> ChxMetronome -> Bool
$c/= :: ChxMetronome -> ChxMetronome -> Bool
== :: ChxMetronome -> ChxMetronome -> Bool
$c== :: ChxMetronome -> ChxMetronome -> Bool
Eq,Typeable,(forall x. ChxMetronome -> Rep ChxMetronome x)
-> (forall x. Rep ChxMetronome x -> ChxMetronome)
-> Generic ChxMetronome
forall x. Rep ChxMetronome x -> ChxMetronome
forall x. ChxMetronome -> Rep ChxMetronome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxMetronome x -> ChxMetronome
$cfrom :: forall x. ChxMetronome -> Rep ChxMetronome x
Generic,Int -> ChxMetronome -> ShowS
[ChxMetronome] -> ShowS
ChxMetronome -> String
(Int -> ChxMetronome -> ShowS)
-> (ChxMetronome -> String)
-> ([ChxMetronome] -> ShowS)
-> Show ChxMetronome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxMetronome] -> ShowS
$cshowList :: [ChxMetronome] -> ShowS
show :: ChxMetronome -> String
$cshow :: ChxMetronome -> String
showsPrec :: Int -> ChxMetronome -> ShowS
$cshowsPrec :: Int -> ChxMetronome -> ShowS
Show)
instance EmitXml ChxMetronome where
    emitXml :: ChxMetronome -> XmlRep
emitXml (ChxMetronomeBeatUnit BeatUnit
a [BeatUnitTied]
b ChxMetronome0
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([BeatUnit -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml BeatUnit
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (BeatUnitTied -> XmlRep) -> [BeatUnitTied] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-unit-tied" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (BeatUnitTied -> XmlRep) -> BeatUnitTied -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.BeatUnitTied -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [BeatUnitTied]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [ChxMetronome0 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxMetronome0
c])
    emitXml (MetronomeMetronomeArrows Maybe Empty
a [MetronomeNote]
b Maybe SeqMetronome
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-arrows" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (MetronomeNote -> XmlRep) -> [MetronomeNote] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MetronomeNote -> XmlRep) -> MetronomeNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MetronomeNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [MetronomeNote]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Maybe SeqMetronome -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe SeqMetronome
c])
parseChxMetronome :: P.XParse ChxMetronome
parseChxMetronome :: XParse ChxMetronome
parseChxMetronome = 
      BeatUnit -> [BeatUnitTied] -> ChxMetronome0 -> ChxMetronome
ChxMetronomeBeatUnit
        (BeatUnit -> [BeatUnitTied] -> ChxMetronome0 -> ChxMetronome)
-> XParse BeatUnit
-> XParse ([BeatUnitTied] -> ChxMetronome0 -> ChxMetronome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse BeatUnit
parseBeatUnit
        XParse ([BeatUnitTied] -> ChxMetronome0 -> ChxMetronome)
-> XParse [BeatUnitTied] -> XParse (ChxMetronome0 -> ChxMetronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse BeatUnitTied -> XParse [BeatUnitTied]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse BeatUnitTied -> XParse BeatUnitTied
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-unit-tied") (XParse BeatUnitTied
parseBeatUnitTied))
        XParse (ChxMetronome0 -> ChxMetronome)
-> XParse ChxMetronome0 -> XParse ChxMetronome
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxMetronome0
parseChxMetronome0
      XParse ChxMetronome -> XParse ChxMetronome -> XParse ChxMetronome
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Empty
-> [MetronomeNote] -> Maybe SeqMetronome -> ChxMetronome
MetronomeMetronomeArrows
        (Maybe Empty
 -> [MetronomeNote] -> Maybe SeqMetronome -> ChxMetronome)
-> XParse (Maybe Empty)
-> XParse ([MetronomeNote] -> Maybe SeqMetronome -> ChxMetronome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-arrows") (XParse Empty
parseEmpty))
        XParse ([MetronomeNote] -> Maybe SeqMetronome -> ChxMetronome)
-> XParse [MetronomeNote]
-> XParse (Maybe SeqMetronome -> ChxMetronome)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MetronomeNote -> XParse [MetronomeNote]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse MetronomeNote -> XParse MetronomeNote
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-note") (XParse MetronomeNote
parseMetronomeNote))
        XParse (Maybe SeqMetronome -> ChxMetronome)
-> XParse (Maybe SeqMetronome) -> XParse ChxMetronome
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SeqMetronome -> XParse (Maybe SeqMetronome)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse SeqMetronome
parseSeqMetronome)

-- | Smart constructor for 'ChxMetronomeBeatUnit'
mkChxMetronomeBeatUnit :: BeatUnit -> ChxMetronome0 -> ChxMetronome
mkChxMetronomeBeatUnit :: BeatUnit -> ChxMetronome0 -> ChxMetronome
mkChxMetronomeBeatUnit BeatUnit
a ChxMetronome0
c = BeatUnit -> [BeatUnitTied] -> ChxMetronome0 -> ChxMetronome
ChxMetronomeBeatUnit BeatUnit
a [] ChxMetronome0
c
-- | Smart constructor for 'MetronomeMetronomeArrows'
mkMetronomeMetronomeArrows :: ChxMetronome
mkMetronomeMetronomeArrows :: ChxMetronome
mkMetronomeMetronomeArrows = Maybe Empty
-> [MetronomeNote] -> Maybe SeqMetronome -> ChxMetronome
MetronomeMetronomeArrows Maybe Empty
forall a. Maybe a
Nothing [] Maybe SeqMetronome
forall a. Maybe a
Nothing

-- | @music-data@ /(choice)/
data ChxMusicData = 
      MusicDataNote {
          ChxMusicData -> Note
musicDataNote :: Note -- ^ /note/ child element
       }
    | MusicDataBackup {
          ChxMusicData -> Backup
musicDataBackup :: Backup -- ^ /backup/ child element
       }
    | MusicDataForward {
          ChxMusicData -> Forward
musicDataForward :: Forward -- ^ /forward/ child element
       }
    | MusicDataDirection {
          ChxMusicData -> Direction
musicDataDirection :: Direction -- ^ /direction/ child element
       }
    | MusicDataAttributes {
          ChxMusicData -> Attributes
musicDataAttributes :: Attributes -- ^ /attributes/ child element
       }
    | MusicDataHarmony {
          ChxMusicData -> Harmony
musicDataHarmony :: Harmony -- ^ /harmony/ child element
       }
    | MusicDataFiguredBass {
          ChxMusicData -> FiguredBass
musicDataFiguredBass :: FiguredBass -- ^ /figured-bass/ child element
       }
    | MusicDataPrint {
          ChxMusicData -> Print
musicDataPrint :: Print -- ^ /print/ child element
       }
    | MusicDataSound {
          ChxMusicData -> Sound
musicDataSound :: Sound -- ^ /sound/ child element
       }
    | MusicDataBarline {
          ChxMusicData -> Barline
musicDataBarline :: Barline -- ^ /barline/ child element
       }
    | MusicDataGrouping {
          ChxMusicData -> Grouping
musicDataGrouping :: Grouping -- ^ /grouping/ child element
       }
    | MusicDataLink {
          ChxMusicData -> Link
musicDataLink :: Link -- ^ /link/ child element
       }
    | MusicDataBookmark {
          ChxMusicData -> Bookmark
musicDataBookmark :: Bookmark -- ^ /bookmark/ child element
       }
    deriving (ChxMusicData -> ChxMusicData -> Bool
(ChxMusicData -> ChxMusicData -> Bool)
-> (ChxMusicData -> ChxMusicData -> Bool) -> Eq ChxMusicData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxMusicData -> ChxMusicData -> Bool
$c/= :: ChxMusicData -> ChxMusicData -> Bool
== :: ChxMusicData -> ChxMusicData -> Bool
$c== :: ChxMusicData -> ChxMusicData -> Bool
Eq,Typeable,(forall x. ChxMusicData -> Rep ChxMusicData x)
-> (forall x. Rep ChxMusicData x -> ChxMusicData)
-> Generic ChxMusicData
forall x. Rep ChxMusicData x -> ChxMusicData
forall x. ChxMusicData -> Rep ChxMusicData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxMusicData x -> ChxMusicData
$cfrom :: forall x. ChxMusicData -> Rep ChxMusicData x
Generic,Int -> ChxMusicData -> ShowS
[ChxMusicData] -> ShowS
ChxMusicData -> String
(Int -> ChxMusicData -> ShowS)
-> (ChxMusicData -> String)
-> ([ChxMusicData] -> ShowS)
-> Show ChxMusicData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxMusicData] -> ShowS
$cshowList :: [ChxMusicData] -> ShowS
show :: ChxMusicData -> String
$cshow :: ChxMusicData -> String
showsPrec :: Int -> ChxMusicData -> ShowS
$cshowsPrec :: Int -> ChxMusicData -> ShowS
Show)
instance EmitXml ChxMusicData where
    emitXml :: ChxMusicData -> XmlRep
emitXml (MusicDataNote Note
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"note" Maybe String
forall a. Maybe a
Nothing) (Note -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Note
a)])
    emitXml (MusicDataBackup Backup
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"backup" Maybe String
forall a. Maybe a
Nothing) (Backup -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Backup
a)])
    emitXml (MusicDataForward Forward
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"forward" Maybe String
forall a. Maybe a
Nothing) (Forward -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Forward
a)])
    emitXml (MusicDataDirection Direction
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"direction" Maybe String
forall a. Maybe a
Nothing) (Direction -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Direction
a)])
    emitXml (MusicDataAttributes Attributes
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"attributes" Maybe String
forall a. Maybe a
Nothing) (Attributes -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Attributes
a)])
    emitXml (MusicDataHarmony Harmony
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"harmony" Maybe String
forall a. Maybe a
Nothing) (Harmony -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Harmony
a)])
    emitXml (MusicDataFiguredBass FiguredBass
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"figured-bass" Maybe String
forall a. Maybe a
Nothing) (FiguredBass -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FiguredBass
a)])
    emitXml (MusicDataPrint Print
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"print" Maybe String
forall a. Maybe a
Nothing) (Print -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Print
a)])
    emitXml (MusicDataSound Sound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"sound" Maybe String
forall a. Maybe a
Nothing) (Sound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Sound
a)])
    emitXml (MusicDataBarline Barline
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"barline" Maybe String
forall a. Maybe a
Nothing) (Barline -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Barline
a)])
    emitXml (MusicDataGrouping Grouping
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"grouping" Maybe String
forall a. Maybe a
Nothing) (Grouping -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Grouping
a)])
    emitXml (MusicDataLink Link
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"link" Maybe String
forall a. Maybe a
Nothing) (Link -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Link
a)])
    emitXml (MusicDataBookmark Bookmark
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bookmark" Maybe String
forall a. Maybe a
Nothing) (Bookmark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Bookmark
a)])
parseChxMusicData :: P.XParse ChxMusicData
parseChxMusicData :: XParse ChxMusicData
parseChxMusicData = 
      Note -> ChxMusicData
MusicDataNote
        (Note -> ChxMusicData) -> XParse Note -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Note -> XParse Note
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"note") (XParse Note
parseNote))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Backup -> ChxMusicData
MusicDataBackup
        (Backup -> ChxMusicData) -> XParse Backup -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Backup -> XParse Backup
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"backup") (XParse Backup
parseBackup))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Forward -> ChxMusicData
MusicDataForward
        (Forward -> ChxMusicData) -> XParse Forward -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Forward -> XParse Forward
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"forward") (XParse Forward
parseForward))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Direction -> ChxMusicData
MusicDataDirection
        (Direction -> ChxMusicData)
-> XParse Direction -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Direction -> XParse Direction
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"direction") (XParse Direction
parseDirection))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Attributes -> ChxMusicData
MusicDataAttributes
        (Attributes -> ChxMusicData)
-> XParse Attributes -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Attributes -> XParse Attributes
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"attributes") (XParse Attributes
parseAttributes))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Harmony -> ChxMusicData
MusicDataHarmony
        (Harmony -> ChxMusicData) -> XParse Harmony -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Harmony -> XParse Harmony
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"harmony") (XParse Harmony
parseHarmony))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FiguredBass -> ChxMusicData
MusicDataFiguredBass
        (FiguredBass -> ChxMusicData)
-> XParse FiguredBass -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FiguredBass -> XParse FiguredBass
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"figured-bass") (XParse FiguredBass
parseFiguredBass))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Print -> ChxMusicData
MusicDataPrint
        (Print -> ChxMusicData) -> XParse Print -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Print -> XParse Print
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"print") (XParse Print
parsePrint))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Sound -> ChxMusicData
MusicDataSound
        (Sound -> ChxMusicData) -> XParse Sound -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Sound -> XParse Sound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"sound") (XParse Sound
parseSound))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Barline -> ChxMusicData
MusicDataBarline
        (Barline -> ChxMusicData) -> XParse Barline -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Barline -> XParse Barline
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"barline") (XParse Barline
parseBarline))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Grouping -> ChxMusicData
MusicDataGrouping
        (Grouping -> ChxMusicData)
-> XParse Grouping -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Grouping -> XParse Grouping
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"grouping") (XParse Grouping
parseGrouping))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Link -> ChxMusicData
MusicDataLink
        (Link -> ChxMusicData) -> XParse Link -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Link -> XParse Link
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"link") (XParse Link
parseLink))
      XParse ChxMusicData -> XParse ChxMusicData -> XParse ChxMusicData
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bookmark -> ChxMusicData
MusicDataBookmark
        (Bookmark -> ChxMusicData)
-> XParse Bookmark -> XParse ChxMusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Bookmark -> XParse Bookmark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bookmark") (XParse Bookmark
parseBookmark))

-- | Smart constructor for 'MusicDataNote'
mkMusicDataNote :: Note -> ChxMusicData
mkMusicDataNote :: Note -> ChxMusicData
mkMusicDataNote Note
a = Note -> ChxMusicData
MusicDataNote Note
a
-- | Smart constructor for 'MusicDataBackup'
mkMusicDataBackup :: Backup -> ChxMusicData
mkMusicDataBackup :: Backup -> ChxMusicData
mkMusicDataBackup Backup
a = Backup -> ChxMusicData
MusicDataBackup Backup
a
-- | Smart constructor for 'MusicDataForward'
mkMusicDataForward :: Forward -> ChxMusicData
mkMusicDataForward :: Forward -> ChxMusicData
mkMusicDataForward Forward
a = Forward -> ChxMusicData
MusicDataForward Forward
a
-- | Smart constructor for 'MusicDataDirection'
mkMusicDataDirection :: Direction -> ChxMusicData
mkMusicDataDirection :: Direction -> ChxMusicData
mkMusicDataDirection Direction
a = Direction -> ChxMusicData
MusicDataDirection Direction
a
-- | Smart constructor for 'MusicDataAttributes'
mkMusicDataAttributes :: Attributes -> ChxMusicData
mkMusicDataAttributes :: Attributes -> ChxMusicData
mkMusicDataAttributes Attributes
a = Attributes -> ChxMusicData
MusicDataAttributes Attributes
a
-- | Smart constructor for 'MusicDataHarmony'
mkMusicDataHarmony :: Harmony -> ChxMusicData
mkMusicDataHarmony :: Harmony -> ChxMusicData
mkMusicDataHarmony Harmony
a = Harmony -> ChxMusicData
MusicDataHarmony Harmony
a
-- | Smart constructor for 'MusicDataFiguredBass'
mkMusicDataFiguredBass :: FiguredBass -> ChxMusicData
mkMusicDataFiguredBass :: FiguredBass -> ChxMusicData
mkMusicDataFiguredBass FiguredBass
a = FiguredBass -> ChxMusicData
MusicDataFiguredBass FiguredBass
a
-- | Smart constructor for 'MusicDataPrint'
mkMusicDataPrint :: Print -> ChxMusicData
mkMusicDataPrint :: Print -> ChxMusicData
mkMusicDataPrint Print
a = Print -> ChxMusicData
MusicDataPrint Print
a
-- | Smart constructor for 'MusicDataSound'
mkMusicDataSound :: Sound -> ChxMusicData
mkMusicDataSound :: Sound -> ChxMusicData
mkMusicDataSound Sound
a = Sound -> ChxMusicData
MusicDataSound Sound
a
-- | Smart constructor for 'MusicDataBarline'
mkMusicDataBarline :: Barline -> ChxMusicData
mkMusicDataBarline :: Barline -> ChxMusicData
mkMusicDataBarline Barline
a = Barline -> ChxMusicData
MusicDataBarline Barline
a
-- | Smart constructor for 'MusicDataGrouping'
mkMusicDataGrouping :: Grouping -> ChxMusicData
mkMusicDataGrouping :: Grouping -> ChxMusicData
mkMusicDataGrouping Grouping
a = Grouping -> ChxMusicData
MusicDataGrouping Grouping
a
-- | Smart constructor for 'MusicDataLink'
mkMusicDataLink :: Link -> ChxMusicData
mkMusicDataLink :: Link -> ChxMusicData
mkMusicDataLink Link
a = Link -> ChxMusicData
MusicDataLink Link
a
-- | Smart constructor for 'MusicDataBookmark'
mkMusicDataBookmark :: Bookmark -> ChxMusicData
mkMusicDataBookmark :: Bookmark -> ChxMusicData
mkMusicDataBookmark Bookmark
a = Bookmark -> ChxMusicData
MusicDataBookmark Bookmark
a

-- | @name-display@ /(choice)/
data ChxNameDisplay = 
      NameDisplayDisplayText {
          ChxNameDisplay -> FormattedText
nameDisplayDisplayText :: FormattedText -- ^ /display-text/ child element
       }
    | NameDisplayAccidentalText {
          ChxNameDisplay -> AccidentalText
nameDisplayAccidentalText :: AccidentalText -- ^ /accidental-text/ child element
       }
    deriving (ChxNameDisplay -> ChxNameDisplay -> Bool
(ChxNameDisplay -> ChxNameDisplay -> Bool)
-> (ChxNameDisplay -> ChxNameDisplay -> Bool) -> Eq ChxNameDisplay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxNameDisplay -> ChxNameDisplay -> Bool
$c/= :: ChxNameDisplay -> ChxNameDisplay -> Bool
== :: ChxNameDisplay -> ChxNameDisplay -> Bool
$c== :: ChxNameDisplay -> ChxNameDisplay -> Bool
Eq,Typeable,(forall x. ChxNameDisplay -> Rep ChxNameDisplay x)
-> (forall x. Rep ChxNameDisplay x -> ChxNameDisplay)
-> Generic ChxNameDisplay
forall x. Rep ChxNameDisplay x -> ChxNameDisplay
forall x. ChxNameDisplay -> Rep ChxNameDisplay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxNameDisplay x -> ChxNameDisplay
$cfrom :: forall x. ChxNameDisplay -> Rep ChxNameDisplay x
Generic,Int -> ChxNameDisplay -> ShowS
[ChxNameDisplay] -> ShowS
ChxNameDisplay -> String
(Int -> ChxNameDisplay -> ShowS)
-> (ChxNameDisplay -> String)
-> ([ChxNameDisplay] -> ShowS)
-> Show ChxNameDisplay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxNameDisplay] -> ShowS
$cshowList :: [ChxNameDisplay] -> ShowS
show :: ChxNameDisplay -> String
$cshow :: ChxNameDisplay -> String
showsPrec :: Int -> ChxNameDisplay -> ShowS
$cshowsPrec :: Int -> ChxNameDisplay -> ShowS
Show)
instance EmitXml ChxNameDisplay where
    emitXml :: ChxNameDisplay -> XmlRep
emitXml (NameDisplayDisplayText FormattedText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"display-text" Maybe String
forall a. Maybe a
Nothing) (FormattedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedText
a)])
    emitXml (NameDisplayAccidentalText AccidentalText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accidental-text" Maybe String
forall a. Maybe a
Nothing) (AccidentalText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalText
a)])
parseChxNameDisplay :: P.XParse ChxNameDisplay
parseChxNameDisplay :: XParse ChxNameDisplay
parseChxNameDisplay = 
      FormattedText -> ChxNameDisplay
NameDisplayDisplayText
        (FormattedText -> ChxNameDisplay)
-> XParse FormattedText -> XParse ChxNameDisplay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedText -> XParse FormattedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"display-text") (XParse FormattedText
parseFormattedText))
      XParse ChxNameDisplay
-> XParse ChxNameDisplay -> XParse ChxNameDisplay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AccidentalText -> ChxNameDisplay
NameDisplayAccidentalText
        (AccidentalText -> ChxNameDisplay)
-> XParse AccidentalText -> XParse ChxNameDisplay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse AccidentalText -> XParse AccidentalText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accidental-text") (XParse AccidentalText
parseAccidentalText))

-- | Smart constructor for 'NameDisplayDisplayText'
mkNameDisplayDisplayText :: FormattedText -> ChxNameDisplay
mkNameDisplayDisplayText :: FormattedText -> ChxNameDisplay
mkNameDisplayDisplayText FormattedText
a = FormattedText -> ChxNameDisplay
NameDisplayDisplayText FormattedText
a
-- | Smart constructor for 'NameDisplayAccidentalText'
mkNameDisplayAccidentalText :: AccidentalText -> ChxNameDisplay
mkNameDisplayAccidentalText :: AccidentalText -> ChxNameDisplay
mkNameDisplayAccidentalText AccidentalText
a = AccidentalText -> ChxNameDisplay
NameDisplayAccidentalText AccidentalText
a

-- | @notations@ /(choice)/
data ChxNotations = 
      NotationsTied {
          ChxNotations -> Tied
notationsTied :: Tied -- ^ /tied/ child element
       }
    | NotationsSlur {
          ChxNotations -> Slur
notationsSlur :: Slur -- ^ /slur/ child element
       }
    | NotationsTuplet {
          ChxNotations -> Tuplet
notationsTuplet :: Tuplet -- ^ /tuplet/ child element
       }
    | NotationsGlissando {
          ChxNotations -> Glissando
notationsGlissando :: Glissando -- ^ /glissando/ child element
       }
    | NotationsSlide {
          ChxNotations -> Slide
notationsSlide :: Slide -- ^ /slide/ child element
       }
    | NotationsOrnaments {
          ChxNotations -> Ornaments
notationsOrnaments :: Ornaments -- ^ /ornaments/ child element
       }
    | NotationsTechnical {
          ChxNotations -> Technical
notationsTechnical :: Technical -- ^ /technical/ child element
       }
    | NotationsArticulations {
          ChxNotations -> Articulations
notationsArticulations :: Articulations -- ^ /articulations/ child element
       }
    | NotationsDynamics {
          ChxNotations -> Dynamics
notationsDynamics :: Dynamics -- ^ /dynamics/ child element
       }
    | NotationsFermata {
          ChxNotations -> Fermata
notationsFermata :: Fermata -- ^ /fermata/ child element
       }
    | NotationsArpeggiate {
          ChxNotations -> Arpeggiate
notationsArpeggiate :: Arpeggiate -- ^ /arpeggiate/ child element
       }
    | NotationsNonArpeggiate {
          ChxNotations -> NonArpeggiate
notationsNonArpeggiate :: NonArpeggiate -- ^ /non-arpeggiate/ child element
       }
    | NotationsAccidentalMark {
          ChxNotations -> AccidentalMark
notationsAccidentalMark :: AccidentalMark -- ^ /accidental-mark/ child element
       }
    | NotationsOtherNotation {
          ChxNotations -> OtherNotation
notationsOtherNotation :: OtherNotation -- ^ /other-notation/ child element
       }
    deriving (ChxNotations -> ChxNotations -> Bool
(ChxNotations -> ChxNotations -> Bool)
-> (ChxNotations -> ChxNotations -> Bool) -> Eq ChxNotations
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxNotations -> ChxNotations -> Bool
$c/= :: ChxNotations -> ChxNotations -> Bool
== :: ChxNotations -> ChxNotations -> Bool
$c== :: ChxNotations -> ChxNotations -> Bool
Eq,Typeable,(forall x. ChxNotations -> Rep ChxNotations x)
-> (forall x. Rep ChxNotations x -> ChxNotations)
-> Generic ChxNotations
forall x. Rep ChxNotations x -> ChxNotations
forall x. ChxNotations -> Rep ChxNotations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxNotations x -> ChxNotations
$cfrom :: forall x. ChxNotations -> Rep ChxNotations x
Generic,Int -> ChxNotations -> ShowS
[ChxNotations] -> ShowS
ChxNotations -> String
(Int -> ChxNotations -> ShowS)
-> (ChxNotations -> String)
-> ([ChxNotations] -> ShowS)
-> Show ChxNotations
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxNotations] -> ShowS
$cshowList :: [ChxNotations] -> ShowS
show :: ChxNotations -> String
$cshow :: ChxNotations -> String
showsPrec :: Int -> ChxNotations -> ShowS
$cshowsPrec :: Int -> ChxNotations -> ShowS
Show)
instance EmitXml ChxNotations where
    emitXml :: ChxNotations -> XmlRep
emitXml (NotationsTied Tied
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tied" Maybe String
forall a. Maybe a
Nothing) (Tied -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tied
a)])
    emitXml (NotationsSlur Slur
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"slur" Maybe String
forall a. Maybe a
Nothing) (Slur -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Slur
a)])
    emitXml (NotationsTuplet Tuplet
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuplet" Maybe String
forall a. Maybe a
Nothing) (Tuplet -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tuplet
a)])
    emitXml (NotationsGlissando Glissando
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"glissando" Maybe String
forall a. Maybe a
Nothing) (Glissando -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Glissando
a)])
    emitXml (NotationsSlide Slide
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"slide" Maybe String
forall a. Maybe a
Nothing) (Slide -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Slide
a)])
    emitXml (NotationsOrnaments Ornaments
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ornaments" Maybe String
forall a. Maybe a
Nothing) (Ornaments -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Ornaments
a)])
    emitXml (NotationsTechnical Technical
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"technical" Maybe String
forall a. Maybe a
Nothing) (Technical -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Technical
a)])
    emitXml (NotationsArticulations Articulations
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"articulations" Maybe String
forall a. Maybe a
Nothing) (Articulations -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Articulations
a)])
    emitXml (NotationsDynamics Dynamics
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"dynamics" Maybe String
forall a. Maybe a
Nothing) (Dynamics -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Dynamics
a)])
    emitXml (NotationsFermata Fermata
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fermata" Maybe String
forall a. Maybe a
Nothing) (Fermata -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fermata
a)])
    emitXml (NotationsArpeggiate Arpeggiate
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"arpeggiate" Maybe String
forall a. Maybe a
Nothing) (Arpeggiate -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Arpeggiate
a)])
    emitXml (NotationsNonArpeggiate NonArpeggiate
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"non-arpeggiate" Maybe String
forall a. Maybe a
Nothing) (NonArpeggiate -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NonArpeggiate
a)])
    emitXml (NotationsAccidentalMark AccidentalMark
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accidental-mark" Maybe String
forall a. Maybe a
Nothing) (AccidentalMark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalMark
a)])
    emitXml (NotationsOtherNotation OtherNotation
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-notation" Maybe String
forall a. Maybe a
Nothing) (OtherNotation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherNotation
a)])
parseChxNotations :: P.XParse ChxNotations
parseChxNotations :: XParse ChxNotations
parseChxNotations = 
      Tied -> ChxNotations
NotationsTied
        (Tied -> ChxNotations) -> XParse Tied -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tied -> XParse Tied
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tied") (XParse Tied
parseTied))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Slur -> ChxNotations
NotationsSlur
        (Slur -> ChxNotations) -> XParse Slur -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Slur -> XParse Slur
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"slur") (XParse Slur
parseSlur))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tuplet -> ChxNotations
NotationsTuplet
        (Tuplet -> ChxNotations) -> XParse Tuplet -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tuplet -> XParse Tuplet
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuplet") (XParse Tuplet
parseTuplet))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Glissando -> ChxNotations
NotationsGlissando
        (Glissando -> ChxNotations)
-> XParse Glissando -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Glissando -> XParse Glissando
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"glissando") (XParse Glissando
parseGlissando))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Slide -> ChxNotations
NotationsSlide
        (Slide -> ChxNotations) -> XParse Slide -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Slide -> XParse Slide
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"slide") (XParse Slide
parseSlide))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Ornaments -> ChxNotations
NotationsOrnaments
        (Ornaments -> ChxNotations)
-> XParse Ornaments -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Ornaments -> XParse Ornaments
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ornaments") (XParse Ornaments
parseOrnaments))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Technical -> ChxNotations
NotationsTechnical
        (Technical -> ChxNotations)
-> XParse Technical -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Technical -> XParse Technical
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"technical") (XParse Technical
parseTechnical))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Articulations -> ChxNotations
NotationsArticulations
        (Articulations -> ChxNotations)
-> XParse Articulations -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Articulations -> XParse Articulations
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"articulations") (XParse Articulations
parseArticulations))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Dynamics -> ChxNotations
NotationsDynamics
        (Dynamics -> ChxNotations)
-> XParse Dynamics -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Dynamics -> XParse Dynamics
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"dynamics") (XParse Dynamics
parseDynamics))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Fermata -> ChxNotations
NotationsFermata
        (Fermata -> ChxNotations) -> XParse Fermata -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Fermata -> XParse Fermata
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fermata") (XParse Fermata
parseFermata))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Arpeggiate -> ChxNotations
NotationsArpeggiate
        (Arpeggiate -> ChxNotations)
-> XParse Arpeggiate -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Arpeggiate -> XParse Arpeggiate
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"arpeggiate") (XParse Arpeggiate
parseArpeggiate))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NonArpeggiate -> ChxNotations
NotationsNonArpeggiate
        (NonArpeggiate -> ChxNotations)
-> XParse NonArpeggiate -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NonArpeggiate -> XParse NonArpeggiate
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"non-arpeggiate") (XParse NonArpeggiate
parseNonArpeggiate))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AccidentalMark -> ChxNotations
NotationsAccidentalMark
        (AccidentalMark -> ChxNotations)
-> XParse AccidentalMark -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse AccidentalMark -> XParse AccidentalMark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accidental-mark") (XParse AccidentalMark
parseAccidentalMark))
      XParse ChxNotations -> XParse ChxNotations -> XParse ChxNotations
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherNotation -> ChxNotations
NotationsOtherNotation
        (OtherNotation -> ChxNotations)
-> XParse OtherNotation -> XParse ChxNotations
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherNotation -> XParse OtherNotation
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-notation") (XParse OtherNotation
parseOtherNotation))

-- | Smart constructor for 'NotationsTied'
mkNotationsTied :: Tied -> ChxNotations
mkNotationsTied :: Tied -> ChxNotations
mkNotationsTied Tied
a = Tied -> ChxNotations
NotationsTied Tied
a
-- | Smart constructor for 'NotationsSlur'
mkNotationsSlur :: Slur -> ChxNotations
mkNotationsSlur :: Slur -> ChxNotations
mkNotationsSlur Slur
a = Slur -> ChxNotations
NotationsSlur Slur
a
-- | Smart constructor for 'NotationsTuplet'
mkNotationsTuplet :: Tuplet -> ChxNotations
mkNotationsTuplet :: Tuplet -> ChxNotations
mkNotationsTuplet Tuplet
a = Tuplet -> ChxNotations
NotationsTuplet Tuplet
a
-- | Smart constructor for 'NotationsGlissando'
mkNotationsGlissando :: Glissando -> ChxNotations
mkNotationsGlissando :: Glissando -> ChxNotations
mkNotationsGlissando Glissando
a = Glissando -> ChxNotations
NotationsGlissando Glissando
a
-- | Smart constructor for 'NotationsSlide'
mkNotationsSlide :: Slide -> ChxNotations
mkNotationsSlide :: Slide -> ChxNotations
mkNotationsSlide Slide
a = Slide -> ChxNotations
NotationsSlide Slide
a
-- | Smart constructor for 'NotationsOrnaments'
mkNotationsOrnaments :: Ornaments -> ChxNotations
mkNotationsOrnaments :: Ornaments -> ChxNotations
mkNotationsOrnaments Ornaments
a = Ornaments -> ChxNotations
NotationsOrnaments Ornaments
a
-- | Smart constructor for 'NotationsTechnical'
mkNotationsTechnical :: Technical -> ChxNotations
mkNotationsTechnical :: Technical -> ChxNotations
mkNotationsTechnical Technical
a = Technical -> ChxNotations
NotationsTechnical Technical
a
-- | Smart constructor for 'NotationsArticulations'
mkNotationsArticulations :: Articulations -> ChxNotations
mkNotationsArticulations :: Articulations -> ChxNotations
mkNotationsArticulations Articulations
a = Articulations -> ChxNotations
NotationsArticulations Articulations
a
-- | Smart constructor for 'NotationsDynamics'
mkNotationsDynamics :: Dynamics -> ChxNotations
mkNotationsDynamics :: Dynamics -> ChxNotations
mkNotationsDynamics Dynamics
a = Dynamics -> ChxNotations
NotationsDynamics Dynamics
a
-- | Smart constructor for 'NotationsFermata'
mkNotationsFermata :: Fermata -> ChxNotations
mkNotationsFermata :: Fermata -> ChxNotations
mkNotationsFermata Fermata
a = Fermata -> ChxNotations
NotationsFermata Fermata
a
-- | Smart constructor for 'NotationsArpeggiate'
mkNotationsArpeggiate :: Arpeggiate -> ChxNotations
mkNotationsArpeggiate :: Arpeggiate -> ChxNotations
mkNotationsArpeggiate Arpeggiate
a = Arpeggiate -> ChxNotations
NotationsArpeggiate Arpeggiate
a
-- | Smart constructor for 'NotationsNonArpeggiate'
mkNotationsNonArpeggiate :: NonArpeggiate -> ChxNotations
mkNotationsNonArpeggiate :: NonArpeggiate -> ChxNotations
mkNotationsNonArpeggiate NonArpeggiate
a = NonArpeggiate -> ChxNotations
NotationsNonArpeggiate NonArpeggiate
a
-- | Smart constructor for 'NotationsAccidentalMark'
mkNotationsAccidentalMark :: AccidentalMark -> ChxNotations
mkNotationsAccidentalMark :: AccidentalMark -> ChxNotations
mkNotationsAccidentalMark AccidentalMark
a = AccidentalMark -> ChxNotations
NotationsAccidentalMark AccidentalMark
a
-- | Smart constructor for 'NotationsOtherNotation'
mkNotationsOtherNotation :: OtherNotation -> ChxNotations
mkNotationsOtherNotation :: OtherNotation -> ChxNotations
mkNotationsOtherNotation OtherNotation
a = OtherNotation -> ChxNotations
NotationsOtherNotation OtherNotation
a

-- | @note@ /(choice)/
data ChxNote0 = 
      NoteFullNote {
          ChxNote0 -> GrpFullNote
noteFullNote :: GrpFullNote
        , ChxNote0 -> [Tie]
noteTie :: [Tie] -- ^ /tie/ child element
       }
    | NoteCue {
          ChxNote0 -> Empty
noteCue :: Empty -- ^ /cue/ child element
        , ChxNote0 -> GrpFullNote
noteFullNote1 :: GrpFullNote
       }
    deriving (ChxNote0 -> ChxNote0 -> Bool
(ChxNote0 -> ChxNote0 -> Bool)
-> (ChxNote0 -> ChxNote0 -> Bool) -> Eq ChxNote0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxNote0 -> ChxNote0 -> Bool
$c/= :: ChxNote0 -> ChxNote0 -> Bool
== :: ChxNote0 -> ChxNote0 -> Bool
$c== :: ChxNote0 -> ChxNote0 -> Bool
Eq,Typeable,(forall x. ChxNote0 -> Rep ChxNote0 x)
-> (forall x. Rep ChxNote0 x -> ChxNote0) -> Generic ChxNote0
forall x. Rep ChxNote0 x -> ChxNote0
forall x. ChxNote0 -> Rep ChxNote0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxNote0 x -> ChxNote0
$cfrom :: forall x. ChxNote0 -> Rep ChxNote0 x
Generic,Int -> ChxNote0 -> ShowS
[ChxNote0] -> ShowS
ChxNote0 -> String
(Int -> ChxNote0 -> ShowS)
-> (ChxNote0 -> String) -> ([ChxNote0] -> ShowS) -> Show ChxNote0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxNote0] -> ShowS
$cshowList :: [ChxNote0] -> ShowS
show :: ChxNote0 -> String
$cshow :: ChxNote0 -> String
showsPrec :: Int -> ChxNote0 -> ShowS
$cshowsPrec :: Int -> ChxNote0 -> ShowS
Show)
instance EmitXml ChxNote0 where
    emitXml :: ChxNote0 -> XmlRep
emitXml (NoteFullNote GrpFullNote
a [Tie]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([GrpFullNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GrpFullNote
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Tie -> XmlRep) -> [Tie] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tie" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tie -> XmlRep) -> Tie -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tie -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Tie]
b)
    emitXml (NoteCue Empty
a GrpFullNote
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"cue" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [GrpFullNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GrpFullNote
b])
parseChxNote0 :: P.XParse ChxNote0
parseChxNote0 :: XParse ChxNote0
parseChxNote0 = 
      GrpFullNote -> [Tie] -> ChxNote0
NoteFullNote
        (GrpFullNote -> [Tie] -> ChxNote0)
-> XParse GrpFullNote -> XParse ([Tie] -> ChxNote0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse GrpFullNote
parseGrpFullNote
        XParse ([Tie] -> ChxNote0) -> XParse [Tie] -> XParse ChxNote0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tie -> XParse [Tie]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Tie -> XParse Tie
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tie") (XParse Tie
parseTie))
      XParse ChxNote0 -> XParse ChxNote0 -> XParse ChxNote0
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> GrpFullNote -> ChxNote0
NoteCue
        (Empty -> GrpFullNote -> ChxNote0)
-> XParse Empty -> XParse (GrpFullNote -> ChxNote0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"cue") (XParse Empty
parseEmpty))
        XParse (GrpFullNote -> ChxNote0)
-> XParse GrpFullNote -> XParse ChxNote0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GrpFullNote
parseGrpFullNote

-- | Smart constructor for 'NoteFullNote'
mkNoteFullNote :: GrpFullNote -> ChxNote0
mkNoteFullNote :: GrpFullNote -> ChxNote0
mkNoteFullNote GrpFullNote
a = GrpFullNote -> [Tie] -> ChxNote0
NoteFullNote GrpFullNote
a []
-- | Smart constructor for 'NoteCue'
mkNoteCue :: Empty -> GrpFullNote -> ChxNote0
mkNoteCue :: Empty -> GrpFullNote -> ChxNote0
mkNoteCue Empty
a GrpFullNote
b = Empty -> GrpFullNote -> ChxNote0
NoteCue Empty
a GrpFullNote
b

-- | @note@ /(choice)/

-- mangled: 1
data ChxNote = 
      NoteGrace {
          ChxNote -> Grace
noteGrace :: Grace -- ^ /grace/ child element
        , ChxNote -> ChxNote0
chxnoteNote :: ChxNote0
       }
    | ChxNoteCue {
          ChxNote -> Empty
chxnoteCue :: Empty -- ^ /cue/ child element
        , ChxNote -> GrpFullNote
chxnoteFullNote :: GrpFullNote
        , ChxNote -> Duration
noteDuration :: Duration
       }
    | ChxNoteFullNote {
          ChxNote -> GrpFullNote
chxnoteFullNote1 :: GrpFullNote
        , ChxNote -> Duration
noteDuration1 :: Duration
        , ChxNote -> [Tie]
chxnoteTie :: [Tie] -- ^ /tie/ child element
       }
    deriving (ChxNote -> ChxNote -> Bool
(ChxNote -> ChxNote -> Bool)
-> (ChxNote -> ChxNote -> Bool) -> Eq ChxNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxNote -> ChxNote -> Bool
$c/= :: ChxNote -> ChxNote -> Bool
== :: ChxNote -> ChxNote -> Bool
$c== :: ChxNote -> ChxNote -> Bool
Eq,Typeable,(forall x. ChxNote -> Rep ChxNote x)
-> (forall x. Rep ChxNote x -> ChxNote) -> Generic ChxNote
forall x. Rep ChxNote x -> ChxNote
forall x. ChxNote -> Rep ChxNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxNote x -> ChxNote
$cfrom :: forall x. ChxNote -> Rep ChxNote x
Generic,Int -> ChxNote -> ShowS
[ChxNote] -> ShowS
ChxNote -> String
(Int -> ChxNote -> ShowS)
-> (ChxNote -> String) -> ([ChxNote] -> ShowS) -> Show ChxNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxNote] -> ShowS
$cshowList :: [ChxNote] -> ShowS
show :: ChxNote -> String
$cshow :: ChxNote -> String
showsPrec :: Int -> ChxNote -> ShowS
$cshowsPrec :: Int -> ChxNote -> ShowS
Show)
instance EmitXml ChxNote where
    emitXml :: ChxNote -> XmlRep
emitXml (NoteGrace Grace
a ChxNote0
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"grace" Maybe String
forall a. Maybe a
Nothing) (Grace -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Grace
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [ChxNote0 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxNote0
b])
    emitXml (ChxNoteCue Empty
a GrpFullNote
b Duration
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"cue" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [GrpFullNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GrpFullNote
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Duration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Duration
c])
    emitXml (ChxNoteFullNote GrpFullNote
a Duration
b [Tie]
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([GrpFullNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GrpFullNote
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [Duration -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Duration
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Tie -> XmlRep) -> [Tie] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tie" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Tie -> XmlRep) -> Tie -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tie -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Tie]
c)
parseChxNote :: P.XParse ChxNote
parseChxNote :: XParse ChxNote
parseChxNote = 
      Grace -> ChxNote0 -> ChxNote
NoteGrace
        (Grace -> ChxNote0 -> ChxNote)
-> XParse Grace -> XParse (ChxNote0 -> ChxNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Grace -> XParse Grace
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"grace") (XParse Grace
parseGrace))
        XParse (ChxNote0 -> ChxNote) -> XParse ChxNote0 -> XParse ChxNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxNote0
parseChxNote0
      XParse ChxNote -> XParse ChxNote -> XParse ChxNote
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> GrpFullNote -> Duration -> ChxNote
ChxNoteCue
        (Empty -> GrpFullNote -> Duration -> ChxNote)
-> XParse Empty -> XParse (GrpFullNote -> Duration -> ChxNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"cue") (XParse Empty
parseEmpty))
        XParse (GrpFullNote -> Duration -> ChxNote)
-> XParse GrpFullNote -> XParse (Duration -> ChxNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GrpFullNote
parseGrpFullNote
        XParse (Duration -> ChxNote) -> XParse Duration -> XParse ChxNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Duration
parseDuration
      XParse ChxNote -> XParse ChxNote -> XParse ChxNote
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GrpFullNote -> Duration -> [Tie] -> ChxNote
ChxNoteFullNote
        (GrpFullNote -> Duration -> [Tie] -> ChxNote)
-> XParse GrpFullNote -> XParse (Duration -> [Tie] -> ChxNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse GrpFullNote
parseGrpFullNote
        XParse (Duration -> [Tie] -> ChxNote)
-> XParse Duration -> XParse ([Tie] -> ChxNote)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Duration
parseDuration
        XParse ([Tie] -> ChxNote) -> XParse [Tie] -> XParse ChxNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Tie -> XParse [Tie]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Tie -> XParse Tie
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tie") (XParse Tie
parseTie))

-- | Smart constructor for 'NoteGrace'
mkNoteGrace :: Grace -> ChxNote0 -> ChxNote
mkNoteGrace :: Grace -> ChxNote0 -> ChxNote
mkNoteGrace Grace
a ChxNote0
b = Grace -> ChxNote0 -> ChxNote
NoteGrace Grace
a ChxNote0
b
-- | Smart constructor for 'ChxNoteCue'
mkChxNoteCue :: Empty -> GrpFullNote -> Duration -> ChxNote
mkChxNoteCue :: Empty -> GrpFullNote -> Duration -> ChxNote
mkChxNoteCue Empty
a GrpFullNote
b Duration
c = Empty -> GrpFullNote -> Duration -> ChxNote
ChxNoteCue Empty
a GrpFullNote
b Duration
c
-- | Smart constructor for 'ChxNoteFullNote'
mkChxNoteFullNote :: GrpFullNote -> Duration -> ChxNote
mkChxNoteFullNote :: GrpFullNote -> Duration -> ChxNote
mkChxNoteFullNote GrpFullNote
a Duration
b = GrpFullNote -> Duration -> [Tie] -> ChxNote
ChxNoteFullNote GrpFullNote
a Duration
b []

-- | @notehead-text@ /(choice)/
data ChxNoteheadText = 
      NoteheadTextDisplayText {
          ChxNoteheadText -> FormattedText
noteheadTextDisplayText :: FormattedText -- ^ /display-text/ child element
       }
    | NoteheadTextAccidentalText {
          ChxNoteheadText -> AccidentalText
noteheadTextAccidentalText :: AccidentalText -- ^ /accidental-text/ child element
       }
    deriving (ChxNoteheadText -> ChxNoteheadText -> Bool
(ChxNoteheadText -> ChxNoteheadText -> Bool)
-> (ChxNoteheadText -> ChxNoteheadText -> Bool)
-> Eq ChxNoteheadText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxNoteheadText -> ChxNoteheadText -> Bool
$c/= :: ChxNoteheadText -> ChxNoteheadText -> Bool
== :: ChxNoteheadText -> ChxNoteheadText -> Bool
$c== :: ChxNoteheadText -> ChxNoteheadText -> Bool
Eq,Typeable,(forall x. ChxNoteheadText -> Rep ChxNoteheadText x)
-> (forall x. Rep ChxNoteheadText x -> ChxNoteheadText)
-> Generic ChxNoteheadText
forall x. Rep ChxNoteheadText x -> ChxNoteheadText
forall x. ChxNoteheadText -> Rep ChxNoteheadText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxNoteheadText x -> ChxNoteheadText
$cfrom :: forall x. ChxNoteheadText -> Rep ChxNoteheadText x
Generic,Int -> ChxNoteheadText -> ShowS
[ChxNoteheadText] -> ShowS
ChxNoteheadText -> String
(Int -> ChxNoteheadText -> ShowS)
-> (ChxNoteheadText -> String)
-> ([ChxNoteheadText] -> ShowS)
-> Show ChxNoteheadText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxNoteheadText] -> ShowS
$cshowList :: [ChxNoteheadText] -> ShowS
show :: ChxNoteheadText -> String
$cshow :: ChxNoteheadText -> String
showsPrec :: Int -> ChxNoteheadText -> ShowS
$cshowsPrec :: Int -> ChxNoteheadText -> ShowS
Show)
instance EmitXml ChxNoteheadText where
    emitXml :: ChxNoteheadText -> XmlRep
emitXml (NoteheadTextDisplayText FormattedText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"display-text" Maybe String
forall a. Maybe a
Nothing) (FormattedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedText
a)])
    emitXml (NoteheadTextAccidentalText AccidentalText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accidental-text" Maybe String
forall a. Maybe a
Nothing) (AccidentalText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml AccidentalText
a)])
parseChxNoteheadText :: P.XParse ChxNoteheadText
parseChxNoteheadText :: XParse ChxNoteheadText
parseChxNoteheadText = 
      FormattedText -> ChxNoteheadText
NoteheadTextDisplayText
        (FormattedText -> ChxNoteheadText)
-> XParse FormattedText -> XParse ChxNoteheadText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedText -> XParse FormattedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"display-text") (XParse FormattedText
parseFormattedText))
      XParse ChxNoteheadText
-> XParse ChxNoteheadText -> XParse ChxNoteheadText
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AccidentalText -> ChxNoteheadText
NoteheadTextAccidentalText
        (AccidentalText -> ChxNoteheadText)
-> XParse AccidentalText -> XParse ChxNoteheadText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse AccidentalText -> XParse AccidentalText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accidental-text") (XParse AccidentalText
parseAccidentalText))

-- | Smart constructor for 'NoteheadTextDisplayText'
mkNoteheadTextDisplayText :: FormattedText -> ChxNoteheadText
mkNoteheadTextDisplayText :: FormattedText -> ChxNoteheadText
mkNoteheadTextDisplayText FormattedText
a = FormattedText -> ChxNoteheadText
NoteheadTextDisplayText FormattedText
a
-- | Smart constructor for 'NoteheadTextAccidentalText'
mkNoteheadTextAccidentalText :: AccidentalText -> ChxNoteheadText
mkNoteheadTextAccidentalText :: AccidentalText -> ChxNoteheadText
mkNoteheadTextAccidentalText AccidentalText
a = AccidentalText -> ChxNoteheadText
NoteheadTextAccidentalText AccidentalText
a

-- | @ornaments@ /(choice)/
data ChxOrnaments = 
      OrnamentsTrillMark {
          ChxOrnaments -> EmptyTrillSound
ornamentsTrillMark :: EmptyTrillSound -- ^ /trill-mark/ child element
       }
    | OrnamentsTurn {
          ChxOrnaments -> HorizontalTurn
ornamentsTurn :: HorizontalTurn -- ^ /turn/ child element
       }
    | OrnamentsDelayedTurn {
          ChxOrnaments -> HorizontalTurn
ornamentsDelayedTurn :: HorizontalTurn -- ^ /delayed-turn/ child element
       }
    | OrnamentsInvertedTurn {
          ChxOrnaments -> HorizontalTurn
ornamentsInvertedTurn :: HorizontalTurn -- ^ /inverted-turn/ child element
       }
    | OrnamentsDelayedInvertedTurn {
          ChxOrnaments -> HorizontalTurn
ornamentsDelayedInvertedTurn :: HorizontalTurn -- ^ /delayed-inverted-turn/ child element
       }
    | OrnamentsVerticalTurn {
          ChxOrnaments -> EmptyTrillSound
ornamentsVerticalTurn :: EmptyTrillSound -- ^ /vertical-turn/ child element
       }
    | OrnamentsInvertedVerticalTurn {
          ChxOrnaments -> EmptyTrillSound
ornamentsInvertedVerticalTurn :: EmptyTrillSound -- ^ /inverted-vertical-turn/ child element
       }
    | OrnamentsShake {
          ChxOrnaments -> EmptyTrillSound
ornamentsShake :: EmptyTrillSound -- ^ /shake/ child element
       }
    | OrnamentsWavyLine {
          ChxOrnaments -> WavyLine
ornamentsWavyLine :: WavyLine -- ^ /wavy-line/ child element
       }
    | OrnamentsMordent {
          ChxOrnaments -> Mordent
ornamentsMordent :: Mordent -- ^ /mordent/ child element
       }
    | OrnamentsInvertedMordent {
          ChxOrnaments -> Mordent
ornamentsInvertedMordent :: Mordent -- ^ /inverted-mordent/ child element
       }
    | OrnamentsSchleifer {
          ChxOrnaments -> EmptyPlacement
ornamentsSchleifer :: EmptyPlacement -- ^ /schleifer/ child element
       }
    | OrnamentsTremolo {
          ChxOrnaments -> Tremolo
ornamentsTremolo :: Tremolo -- ^ /tremolo/ child element
       }
    | OrnamentsHaydn {
          ChxOrnaments -> EmptyTrillSound
ornamentsHaydn :: EmptyTrillSound -- ^ /haydn/ child element
       }
    | OrnamentsOtherOrnament {
          ChxOrnaments -> OtherPlacementText
ornamentsOtherOrnament :: OtherPlacementText -- ^ /other-ornament/ child element
       }
    deriving (ChxOrnaments -> ChxOrnaments -> Bool
(ChxOrnaments -> ChxOrnaments -> Bool)
-> (ChxOrnaments -> ChxOrnaments -> Bool) -> Eq ChxOrnaments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxOrnaments -> ChxOrnaments -> Bool
$c/= :: ChxOrnaments -> ChxOrnaments -> Bool
== :: ChxOrnaments -> ChxOrnaments -> Bool
$c== :: ChxOrnaments -> ChxOrnaments -> Bool
Eq,Typeable,(forall x. ChxOrnaments -> Rep ChxOrnaments x)
-> (forall x. Rep ChxOrnaments x -> ChxOrnaments)
-> Generic ChxOrnaments
forall x. Rep ChxOrnaments x -> ChxOrnaments
forall x. ChxOrnaments -> Rep ChxOrnaments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxOrnaments x -> ChxOrnaments
$cfrom :: forall x. ChxOrnaments -> Rep ChxOrnaments x
Generic,Int -> ChxOrnaments -> ShowS
[ChxOrnaments] -> ShowS
ChxOrnaments -> String
(Int -> ChxOrnaments -> ShowS)
-> (ChxOrnaments -> String)
-> ([ChxOrnaments] -> ShowS)
-> Show ChxOrnaments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxOrnaments] -> ShowS
$cshowList :: [ChxOrnaments] -> ShowS
show :: ChxOrnaments -> String
$cshow :: ChxOrnaments -> String
showsPrec :: Int -> ChxOrnaments -> ShowS
$cshowsPrec :: Int -> ChxOrnaments -> ShowS
Show)
instance EmitXml ChxOrnaments where
    emitXml :: ChxOrnaments -> XmlRep
emitXml (OrnamentsTrillMark EmptyTrillSound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"trill-mark" Maybe String
forall a. Maybe a
Nothing) (EmptyTrillSound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyTrillSound
a)])
    emitXml (OrnamentsTurn HorizontalTurn
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"turn" Maybe String
forall a. Maybe a
Nothing) (HorizontalTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HorizontalTurn
a)])
    emitXml (OrnamentsDelayedTurn HorizontalTurn
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"delayed-turn" Maybe String
forall a. Maybe a
Nothing) (HorizontalTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HorizontalTurn
a)])
    emitXml (OrnamentsInvertedTurn HorizontalTurn
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"inverted-turn" Maybe String
forall a. Maybe a
Nothing) (HorizontalTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HorizontalTurn
a)])
    emitXml (OrnamentsDelayedInvertedTurn HorizontalTurn
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"delayed-inverted-turn" Maybe String
forall a. Maybe a
Nothing) (HorizontalTurn -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HorizontalTurn
a)])
    emitXml (OrnamentsVerticalTurn EmptyTrillSound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"vertical-turn" Maybe String
forall a. Maybe a
Nothing) (EmptyTrillSound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyTrillSound
a)])
    emitXml (OrnamentsInvertedVerticalTurn EmptyTrillSound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"inverted-vertical-turn" Maybe String
forall a. Maybe a
Nothing) (EmptyTrillSound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyTrillSound
a)])
    emitXml (OrnamentsShake EmptyTrillSound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"shake" Maybe String
forall a. Maybe a
Nothing) (EmptyTrillSound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyTrillSound
a)])
    emitXml (OrnamentsWavyLine WavyLine
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"wavy-line" Maybe String
forall a. Maybe a
Nothing) (WavyLine -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml WavyLine
a)])
    emitXml (OrnamentsMordent Mordent
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"mordent" Maybe String
forall a. Maybe a
Nothing) (Mordent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Mordent
a)])
    emitXml (OrnamentsInvertedMordent Mordent
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"inverted-mordent" Maybe String
forall a. Maybe a
Nothing) (Mordent -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Mordent
a)])
    emitXml (OrnamentsSchleifer EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"schleifer" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (OrnamentsTremolo Tremolo
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tremolo" Maybe String
forall a. Maybe a
Nothing) (Tremolo -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tremolo
a)])
    emitXml (OrnamentsHaydn EmptyTrillSound
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"haydn" Maybe String
forall a. Maybe a
Nothing) (EmptyTrillSound -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyTrillSound
a)])
    emitXml (OrnamentsOtherOrnament OtherPlacementText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-ornament" Maybe String
forall a. Maybe a
Nothing) (OtherPlacementText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherPlacementText
a)])
parseChxOrnaments :: P.XParse ChxOrnaments
parseChxOrnaments :: XParse ChxOrnaments
parseChxOrnaments = 
      EmptyTrillSound -> ChxOrnaments
OrnamentsTrillMark
        (EmptyTrillSound -> ChxOrnaments)
-> XParse EmptyTrillSound -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyTrillSound -> XParse EmptyTrillSound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"trill-mark") (XParse EmptyTrillSound
parseEmptyTrillSound))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HorizontalTurn -> ChxOrnaments
OrnamentsTurn
        (HorizontalTurn -> ChxOrnaments)
-> XParse HorizontalTurn -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HorizontalTurn -> XParse HorizontalTurn
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"turn") (XParse HorizontalTurn
parseHorizontalTurn))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HorizontalTurn -> ChxOrnaments
OrnamentsDelayedTurn
        (HorizontalTurn -> ChxOrnaments)
-> XParse HorizontalTurn -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HorizontalTurn -> XParse HorizontalTurn
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"delayed-turn") (XParse HorizontalTurn
parseHorizontalTurn))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HorizontalTurn -> ChxOrnaments
OrnamentsInvertedTurn
        (HorizontalTurn -> ChxOrnaments)
-> XParse HorizontalTurn -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HorizontalTurn -> XParse HorizontalTurn
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"inverted-turn") (XParse HorizontalTurn
parseHorizontalTurn))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HorizontalTurn -> ChxOrnaments
OrnamentsDelayedInvertedTurn
        (HorizontalTurn -> ChxOrnaments)
-> XParse HorizontalTurn -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HorizontalTurn -> XParse HorizontalTurn
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"delayed-inverted-turn") (XParse HorizontalTurn
parseHorizontalTurn))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyTrillSound -> ChxOrnaments
OrnamentsVerticalTurn
        (EmptyTrillSound -> ChxOrnaments)
-> XParse EmptyTrillSound -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyTrillSound -> XParse EmptyTrillSound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"vertical-turn") (XParse EmptyTrillSound
parseEmptyTrillSound))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyTrillSound -> ChxOrnaments
OrnamentsInvertedVerticalTurn
        (EmptyTrillSound -> ChxOrnaments)
-> XParse EmptyTrillSound -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyTrillSound -> XParse EmptyTrillSound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"inverted-vertical-turn") (XParse EmptyTrillSound
parseEmptyTrillSound))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyTrillSound -> ChxOrnaments
OrnamentsShake
        (EmptyTrillSound -> ChxOrnaments)
-> XParse EmptyTrillSound -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyTrillSound -> XParse EmptyTrillSound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"shake") (XParse EmptyTrillSound
parseEmptyTrillSound))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WavyLine -> ChxOrnaments
OrnamentsWavyLine
        (WavyLine -> ChxOrnaments)
-> XParse WavyLine -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse WavyLine -> XParse WavyLine
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"wavy-line") (XParse WavyLine
parseWavyLine))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mordent -> ChxOrnaments
OrnamentsMordent
        (Mordent -> ChxOrnaments) -> XParse Mordent -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Mordent -> XParse Mordent
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"mordent") (XParse Mordent
parseMordent))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mordent -> ChxOrnaments
OrnamentsInvertedMordent
        (Mordent -> ChxOrnaments) -> XParse Mordent -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Mordent -> XParse Mordent
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"inverted-mordent") (XParse Mordent
parseMordent))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxOrnaments
OrnamentsSchleifer
        (EmptyPlacement -> ChxOrnaments)
-> XParse EmptyPlacement -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"schleifer") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tremolo -> ChxOrnaments
OrnamentsTremolo
        (Tremolo -> ChxOrnaments) -> XParse Tremolo -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tremolo -> XParse Tremolo
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tremolo") (XParse Tremolo
parseTremolo))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyTrillSound -> ChxOrnaments
OrnamentsHaydn
        (EmptyTrillSound -> ChxOrnaments)
-> XParse EmptyTrillSound -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyTrillSound -> XParse EmptyTrillSound
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"haydn") (XParse EmptyTrillSound
parseEmptyTrillSound))
      XParse ChxOrnaments -> XParse ChxOrnaments -> XParse ChxOrnaments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherPlacementText -> ChxOrnaments
OrnamentsOtherOrnament
        (OtherPlacementText -> ChxOrnaments)
-> XParse OtherPlacementText -> XParse ChxOrnaments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherPlacementText -> XParse OtherPlacementText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-ornament") (XParse OtherPlacementText
parseOtherPlacementText))

-- | Smart constructor for 'OrnamentsTrillMark'
mkOrnamentsTrillMark :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsTrillMark :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsTrillMark EmptyTrillSound
a = EmptyTrillSound -> ChxOrnaments
OrnamentsTrillMark EmptyTrillSound
a
-- | Smart constructor for 'OrnamentsTurn'
mkOrnamentsTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsTurn HorizontalTurn
a = HorizontalTurn -> ChxOrnaments
OrnamentsTurn HorizontalTurn
a
-- | Smart constructor for 'OrnamentsDelayedTurn'
mkOrnamentsDelayedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsDelayedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsDelayedTurn HorizontalTurn
a = HorizontalTurn -> ChxOrnaments
OrnamentsDelayedTurn HorizontalTurn
a
-- | Smart constructor for 'OrnamentsInvertedTurn'
mkOrnamentsInvertedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsInvertedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsInvertedTurn HorizontalTurn
a = HorizontalTurn -> ChxOrnaments
OrnamentsInvertedTurn HorizontalTurn
a
-- | Smart constructor for 'OrnamentsDelayedInvertedTurn'
mkOrnamentsDelayedInvertedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsDelayedInvertedTurn :: HorizontalTurn -> ChxOrnaments
mkOrnamentsDelayedInvertedTurn HorizontalTurn
a = HorizontalTurn -> ChxOrnaments
OrnamentsDelayedInvertedTurn HorizontalTurn
a
-- | Smart constructor for 'OrnamentsVerticalTurn'
mkOrnamentsVerticalTurn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsVerticalTurn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsVerticalTurn EmptyTrillSound
a = EmptyTrillSound -> ChxOrnaments
OrnamentsVerticalTurn EmptyTrillSound
a
-- | Smart constructor for 'OrnamentsInvertedVerticalTurn'
mkOrnamentsInvertedVerticalTurn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsInvertedVerticalTurn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsInvertedVerticalTurn EmptyTrillSound
a = EmptyTrillSound -> ChxOrnaments
OrnamentsInvertedVerticalTurn EmptyTrillSound
a
-- | Smart constructor for 'OrnamentsShake'
mkOrnamentsShake :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsShake :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsShake EmptyTrillSound
a = EmptyTrillSound -> ChxOrnaments
OrnamentsShake EmptyTrillSound
a
-- | Smart constructor for 'OrnamentsWavyLine'
mkOrnamentsWavyLine :: WavyLine -> ChxOrnaments
mkOrnamentsWavyLine :: WavyLine -> ChxOrnaments
mkOrnamentsWavyLine WavyLine
a = WavyLine -> ChxOrnaments
OrnamentsWavyLine WavyLine
a
-- | Smart constructor for 'OrnamentsMordent'
mkOrnamentsMordent :: Mordent -> ChxOrnaments
mkOrnamentsMordent :: Mordent -> ChxOrnaments
mkOrnamentsMordent Mordent
a = Mordent -> ChxOrnaments
OrnamentsMordent Mordent
a
-- | Smart constructor for 'OrnamentsInvertedMordent'
mkOrnamentsInvertedMordent :: Mordent -> ChxOrnaments
mkOrnamentsInvertedMordent :: Mordent -> ChxOrnaments
mkOrnamentsInvertedMordent Mordent
a = Mordent -> ChxOrnaments
OrnamentsInvertedMordent Mordent
a
-- | Smart constructor for 'OrnamentsSchleifer'
mkOrnamentsSchleifer :: EmptyPlacement -> ChxOrnaments
mkOrnamentsSchleifer :: EmptyPlacement -> ChxOrnaments
mkOrnamentsSchleifer EmptyPlacement
a = EmptyPlacement -> ChxOrnaments
OrnamentsSchleifer EmptyPlacement
a
-- | Smart constructor for 'OrnamentsTremolo'
mkOrnamentsTremolo :: Tremolo -> ChxOrnaments
mkOrnamentsTremolo :: Tremolo -> ChxOrnaments
mkOrnamentsTremolo Tremolo
a = Tremolo -> ChxOrnaments
OrnamentsTremolo Tremolo
a
-- | Smart constructor for 'OrnamentsHaydn'
mkOrnamentsHaydn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsHaydn :: EmptyTrillSound -> ChxOrnaments
mkOrnamentsHaydn EmptyTrillSound
a = EmptyTrillSound -> ChxOrnaments
OrnamentsHaydn EmptyTrillSound
a
-- | Smart constructor for 'OrnamentsOtherOrnament'
mkOrnamentsOtherOrnament :: OtherPlacementText -> ChxOrnaments
mkOrnamentsOtherOrnament :: OtherPlacementText -> ChxOrnaments
mkOrnamentsOtherOrnament OtherPlacementText
a = OtherPlacementText -> ChxOrnaments
OrnamentsOtherOrnament OtherPlacementText
a

-- | @part-list@ /(choice)/
data ChxPartList = 
      PartListPartGroup {
          ChxPartList -> GrpPartGroup
chxpartListPartGroup :: GrpPartGroup
       }
    | PartListScorePart {
          ChxPartList -> ScorePart
chxpartListScorePart :: ScorePart
       }
    deriving (ChxPartList -> ChxPartList -> Bool
(ChxPartList -> ChxPartList -> Bool)
-> (ChxPartList -> ChxPartList -> Bool) -> Eq ChxPartList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxPartList -> ChxPartList -> Bool
$c/= :: ChxPartList -> ChxPartList -> Bool
== :: ChxPartList -> ChxPartList -> Bool
$c== :: ChxPartList -> ChxPartList -> Bool
Eq,Typeable,(forall x. ChxPartList -> Rep ChxPartList x)
-> (forall x. Rep ChxPartList x -> ChxPartList)
-> Generic ChxPartList
forall x. Rep ChxPartList x -> ChxPartList
forall x. ChxPartList -> Rep ChxPartList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxPartList x -> ChxPartList
$cfrom :: forall x. ChxPartList -> Rep ChxPartList x
Generic,Int -> ChxPartList -> ShowS
[ChxPartList] -> ShowS
ChxPartList -> String
(Int -> ChxPartList -> ShowS)
-> (ChxPartList -> String)
-> ([ChxPartList] -> ShowS)
-> Show ChxPartList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxPartList] -> ShowS
$cshowList :: [ChxPartList] -> ShowS
show :: ChxPartList -> String
$cshow :: ChxPartList -> String
showsPrec :: Int -> ChxPartList -> ShowS
$cshowsPrec :: Int -> ChxPartList -> ShowS
Show)
instance EmitXml ChxPartList where
    emitXml :: ChxPartList -> XmlRep
emitXml (PartListPartGroup GrpPartGroup
a) =
      [XmlRep] -> XmlRep
XReps [GrpPartGroup -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml GrpPartGroup
a]
    emitXml (PartListScorePart ScorePart
a) =
      [XmlRep] -> XmlRep
XReps [ScorePart -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ScorePart
a]
parseChxPartList :: P.XParse ChxPartList
parseChxPartList :: XParse ChxPartList
parseChxPartList = 
      GrpPartGroup -> ChxPartList
PartListPartGroup
        (GrpPartGroup -> ChxPartList)
-> XParse GrpPartGroup -> XParse ChxPartList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse GrpPartGroup
parseGrpPartGroup
      XParse ChxPartList -> XParse ChxPartList -> XParse ChxPartList
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ScorePart -> ChxPartList
PartListScorePart
        (ScorePart -> ChxPartList)
-> XParse ScorePart -> XParse ChxPartList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ScorePart
parseScorePart

-- | Smart constructor for 'PartListPartGroup'
mkPartListPartGroup :: GrpPartGroup -> ChxPartList
mkPartListPartGroup :: GrpPartGroup -> ChxPartList
mkPartListPartGroup GrpPartGroup
a = GrpPartGroup -> ChxPartList
PartListPartGroup GrpPartGroup
a
-- | Smart constructor for 'PartListScorePart'
mkPartListScorePart :: ScorePart -> ChxPartList
mkPartListScorePart :: ScorePart -> ChxPartList
mkPartListScorePart ScorePart
a = ScorePart -> ChxPartList
PartListScorePart ScorePart
a

-- | @percussion@ /(choice)/
data ChxPercussion = 
      PercussionGlass {
          ChxPercussion -> Glass
percussionGlass :: Glass -- ^ /glass/ child element
       }
    | PercussionMetal {
          ChxPercussion -> Metal
percussionMetal :: Metal -- ^ /metal/ child element
       }
    | PercussionWood {
          ChxPercussion -> Wood
percussionWood :: Wood -- ^ /wood/ child element
       }
    | PercussionPitched {
          ChxPercussion -> Pitched
percussionPitched :: Pitched -- ^ /pitched/ child element
       }
    | PercussionMembrane {
          ChxPercussion -> Membrane
percussionMembrane :: Membrane -- ^ /membrane/ child element
       }
    | PercussionEffect {
          ChxPercussion -> Effect
percussionEffect :: Effect -- ^ /effect/ child element
       }
    | PercussionTimpani {
          ChxPercussion -> Empty
percussionTimpani :: Empty -- ^ /timpani/ child element
       }
    | PercussionBeater {
          ChxPercussion -> Beater
percussionBeater :: Beater -- ^ /beater/ child element
       }
    | PercussionStick {
          ChxPercussion -> Stick
percussionStick :: Stick -- ^ /stick/ child element
       }
    | PercussionStickLocation {
          ChxPercussion -> StickLocation
percussionStickLocation :: StickLocation -- ^ /stick-location/ child element
       }
    | PercussionOtherPercussion {
          ChxPercussion -> OtherText
percussionOtherPercussion :: OtherText -- ^ /other-percussion/ child element
       }
    deriving (ChxPercussion -> ChxPercussion -> Bool
(ChxPercussion -> ChxPercussion -> Bool)
-> (ChxPercussion -> ChxPercussion -> Bool) -> Eq ChxPercussion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxPercussion -> ChxPercussion -> Bool
$c/= :: ChxPercussion -> ChxPercussion -> Bool
== :: ChxPercussion -> ChxPercussion -> Bool
$c== :: ChxPercussion -> ChxPercussion -> Bool
Eq,Typeable,(forall x. ChxPercussion -> Rep ChxPercussion x)
-> (forall x. Rep ChxPercussion x -> ChxPercussion)
-> Generic ChxPercussion
forall x. Rep ChxPercussion x -> ChxPercussion
forall x. ChxPercussion -> Rep ChxPercussion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxPercussion x -> ChxPercussion
$cfrom :: forall x. ChxPercussion -> Rep ChxPercussion x
Generic,Int -> ChxPercussion -> ShowS
[ChxPercussion] -> ShowS
ChxPercussion -> String
(Int -> ChxPercussion -> ShowS)
-> (ChxPercussion -> String)
-> ([ChxPercussion] -> ShowS)
-> Show ChxPercussion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxPercussion] -> ShowS
$cshowList :: [ChxPercussion] -> ShowS
show :: ChxPercussion -> String
$cshow :: ChxPercussion -> String
showsPrec :: Int -> ChxPercussion -> ShowS
$cshowsPrec :: Int -> ChxPercussion -> ShowS
Show)
instance EmitXml ChxPercussion where
    emitXml :: ChxPercussion -> XmlRep
emitXml (PercussionGlass Glass
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"glass" Maybe String
forall a. Maybe a
Nothing) (Glass -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Glass
a)])
    emitXml (PercussionMetal Metal
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metal" Maybe String
forall a. Maybe a
Nothing) (Metal -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Metal
a)])
    emitXml (PercussionWood Wood
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"wood" Maybe String
forall a. Maybe a
Nothing) (Wood -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Wood
a)])
    emitXml (PercussionPitched Pitched
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pitched" Maybe String
forall a. Maybe a
Nothing) (Pitched -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Pitched
a)])
    emitXml (PercussionMembrane Membrane
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"membrane" Maybe String
forall a. Maybe a
Nothing) (Membrane -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Membrane
a)])
    emitXml (PercussionEffect Effect
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"effect" Maybe String
forall a. Maybe a
Nothing) (Effect -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Effect
a)])
    emitXml (PercussionTimpani Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"timpani" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (PercussionBeater Beater
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beater" Maybe String
forall a. Maybe a
Nothing) (Beater -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Beater
a)])
    emitXml (PercussionStick Stick
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stick" Maybe String
forall a. Maybe a
Nothing) (Stick -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Stick
a)])
    emitXml (PercussionStickLocation StickLocation
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stick-location" Maybe String
forall a. Maybe a
Nothing) (StickLocation -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml StickLocation
a)])
    emitXml (PercussionOtherPercussion OtherText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-percussion" Maybe String
forall a. Maybe a
Nothing) (OtherText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherText
a)])
parseChxPercussion :: P.XParse ChxPercussion
parseChxPercussion :: XParse ChxPercussion
parseChxPercussion = 
      Glass -> ChxPercussion
PercussionGlass
        (Glass -> ChxPercussion) -> XParse Glass -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Glass -> XParse Glass
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"glass") (XParse Glass
parseGlass))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Metal -> ChxPercussion
PercussionMetal
        (Metal -> ChxPercussion) -> XParse Metal -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Metal -> XParse Metal
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metal") (XParse String
P.xtext XParse String -> (String -> XParse Metal) -> XParse Metal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Metal
parseMetal))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Wood -> ChxPercussion
PercussionWood
        (Wood -> ChxPercussion) -> XParse Wood -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Wood -> XParse Wood
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"wood") (XParse String
P.xtext XParse String -> (String -> XParse Wood) -> XParse Wood
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Wood
parseWood))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Pitched -> ChxPercussion
PercussionPitched
        (Pitched -> ChxPercussion)
-> XParse Pitched -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Pitched -> XParse Pitched
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pitched") (XParse Pitched
parsePitched))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Membrane -> ChxPercussion
PercussionMembrane
        (Membrane -> ChxPercussion)
-> XParse Membrane -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Membrane -> XParse Membrane
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"membrane") (XParse String
P.xtext XParse String -> (String -> XParse Membrane) -> XParse Membrane
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Membrane
parseMembrane))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Effect -> ChxPercussion
PercussionEffect
        (Effect -> ChxPercussion) -> XParse Effect -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Effect -> XParse Effect
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"effect") (XParse String
P.xtext XParse String -> (String -> XParse Effect) -> XParse Effect
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Effect
parseEffect))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Empty -> ChxPercussion
PercussionTimpani
        (Empty -> ChxPercussion) -> XParse Empty -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"timpani") (XParse Empty
parseEmpty))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Beater -> ChxPercussion
PercussionBeater
        (Beater -> ChxPercussion) -> XParse Beater -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Beater -> XParse Beater
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beater") (XParse Beater
parseBeater))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Stick -> ChxPercussion
PercussionStick
        (Stick -> ChxPercussion) -> XParse Stick -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Stick -> XParse Stick
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stick") (XParse Stick
parseStick))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StickLocation -> ChxPercussion
PercussionStickLocation
        (StickLocation -> ChxPercussion)
-> XParse StickLocation -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse StickLocation -> XParse StickLocation
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stick-location") (XParse String
P.xtext XParse String
-> (String -> XParse StickLocation) -> XParse StickLocation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse StickLocation
parseStickLocation))
      XParse ChxPercussion
-> XParse ChxPercussion -> XParse ChxPercussion
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherText -> ChxPercussion
PercussionOtherPercussion
        (OtherText -> ChxPercussion)
-> XParse OtherText -> XParse ChxPercussion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherText -> XParse OtherText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-percussion") (XParse OtherText
parseOtherText))

-- | Smart constructor for 'PercussionGlass'
mkPercussionGlass :: Glass -> ChxPercussion
mkPercussionGlass :: Glass -> ChxPercussion
mkPercussionGlass Glass
a = Glass -> ChxPercussion
PercussionGlass Glass
a
-- | Smart constructor for 'PercussionMetal'
mkPercussionMetal :: Metal -> ChxPercussion
mkPercussionMetal :: Metal -> ChxPercussion
mkPercussionMetal Metal
a = Metal -> ChxPercussion
PercussionMetal Metal
a
-- | Smart constructor for 'PercussionWood'
mkPercussionWood :: Wood -> ChxPercussion
mkPercussionWood :: Wood -> ChxPercussion
mkPercussionWood Wood
a = Wood -> ChxPercussion
PercussionWood Wood
a
-- | Smart constructor for 'PercussionPitched'
mkPercussionPitched :: Pitched -> ChxPercussion
mkPercussionPitched :: Pitched -> ChxPercussion
mkPercussionPitched Pitched
a = Pitched -> ChxPercussion
PercussionPitched Pitched
a
-- | Smart constructor for 'PercussionMembrane'
mkPercussionMembrane :: Membrane -> ChxPercussion
mkPercussionMembrane :: Membrane -> ChxPercussion
mkPercussionMembrane Membrane
a = Membrane -> ChxPercussion
PercussionMembrane Membrane
a
-- | Smart constructor for 'PercussionEffect'
mkPercussionEffect :: Effect -> ChxPercussion
mkPercussionEffect :: Effect -> ChxPercussion
mkPercussionEffect Effect
a = Effect -> ChxPercussion
PercussionEffect Effect
a
-- | Smart constructor for 'PercussionTimpani'
mkPercussionTimpani :: Empty -> ChxPercussion
mkPercussionTimpani :: Empty -> ChxPercussion
mkPercussionTimpani Empty
a = Empty -> ChxPercussion
PercussionTimpani Empty
a
-- | Smart constructor for 'PercussionBeater'
mkPercussionBeater :: Beater -> ChxPercussion
mkPercussionBeater :: Beater -> ChxPercussion
mkPercussionBeater Beater
a = Beater -> ChxPercussion
PercussionBeater Beater
a
-- | Smart constructor for 'PercussionStick'
mkPercussionStick :: Stick -> ChxPercussion
mkPercussionStick :: Stick -> ChxPercussion
mkPercussionStick Stick
a = Stick -> ChxPercussion
PercussionStick Stick
a
-- | Smart constructor for 'PercussionStickLocation'
mkPercussionStickLocation :: StickLocation -> ChxPercussion
mkPercussionStickLocation :: StickLocation -> ChxPercussion
mkPercussionStickLocation StickLocation
a = StickLocation -> ChxPercussion
PercussionStickLocation StickLocation
a
-- | Smart constructor for 'PercussionOtherPercussion'
mkPercussionOtherPercussion :: OtherText -> ChxPercussion
mkPercussionOtherPercussion :: OtherText -> ChxPercussion
mkPercussionOtherPercussion OtherText
a = OtherText -> ChxPercussion
PercussionOtherPercussion OtherText
a

-- | @play@ /(choice)/
data ChxPlay = 
      PlayIpa {
          ChxPlay -> String
playIpa :: String -- ^ /ipa/ child element
       }
    | PlayMute {
          ChxPlay -> Mute
playMute :: Mute -- ^ /mute/ child element
       }
    | PlaySemiPitched {
          ChxPlay -> SemiPitched
playSemiPitched :: SemiPitched -- ^ /semi-pitched/ child element
       }
    | PlayOtherPlay {
          ChxPlay -> OtherPlay
playOtherPlay :: OtherPlay -- ^ /other-play/ child element
       }
    deriving (ChxPlay -> ChxPlay -> Bool
(ChxPlay -> ChxPlay -> Bool)
-> (ChxPlay -> ChxPlay -> Bool) -> Eq ChxPlay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxPlay -> ChxPlay -> Bool
$c/= :: ChxPlay -> ChxPlay -> Bool
== :: ChxPlay -> ChxPlay -> Bool
$c== :: ChxPlay -> ChxPlay -> Bool
Eq,Typeable,(forall x. ChxPlay -> Rep ChxPlay x)
-> (forall x. Rep ChxPlay x -> ChxPlay) -> Generic ChxPlay
forall x. Rep ChxPlay x -> ChxPlay
forall x. ChxPlay -> Rep ChxPlay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxPlay x -> ChxPlay
$cfrom :: forall x. ChxPlay -> Rep ChxPlay x
Generic,Int -> ChxPlay -> ShowS
[ChxPlay] -> ShowS
ChxPlay -> String
(Int -> ChxPlay -> ShowS)
-> (ChxPlay -> String) -> ([ChxPlay] -> ShowS) -> Show ChxPlay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxPlay] -> ShowS
$cshowList :: [ChxPlay] -> ShowS
show :: ChxPlay -> String
$cshow :: ChxPlay -> String
showsPrec :: Int -> ChxPlay -> ShowS
$cshowsPrec :: Int -> ChxPlay -> ShowS
Show)
instance EmitXml ChxPlay where
    emitXml :: ChxPlay -> XmlRep
emitXml (PlayIpa String
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ipa" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)])
    emitXml (PlayMute Mute
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"mute" Maybe String
forall a. Maybe a
Nothing) (Mute -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Mute
a)])
    emitXml (PlaySemiPitched SemiPitched
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"semi-pitched" Maybe String
forall a. Maybe a
Nothing) (SemiPitched -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml SemiPitched
a)])
    emitXml (PlayOtherPlay OtherPlay
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-play" Maybe String
forall a. Maybe a
Nothing) (OtherPlay -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherPlay
a)])
parseChxPlay :: P.XParse ChxPlay
parseChxPlay :: XParse ChxPlay
parseChxPlay = 
      String -> ChxPlay
PlayIpa
        (String -> ChxPlay) -> XParse String -> XParse ChxPlay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ipa") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
      XParse ChxPlay -> XParse ChxPlay -> XParse ChxPlay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mute -> ChxPlay
PlayMute
        (Mute -> ChxPlay) -> XParse Mute -> XParse ChxPlay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Mute -> XParse Mute
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"mute") (XParse String
P.xtext XParse String -> (String -> XParse Mute) -> XParse Mute
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Mute
parseMute))
      XParse ChxPlay -> XParse ChxPlay -> XParse ChxPlay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SemiPitched -> ChxPlay
PlaySemiPitched
        (SemiPitched -> ChxPlay) -> XParse SemiPitched -> XParse ChxPlay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse SemiPitched -> XParse SemiPitched
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"semi-pitched") (XParse String
P.xtext XParse String
-> (String -> XParse SemiPitched) -> XParse SemiPitched
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse SemiPitched
parseSemiPitched))
      XParse ChxPlay -> XParse ChxPlay -> XParse ChxPlay
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherPlay -> ChxPlay
PlayOtherPlay
        (OtherPlay -> ChxPlay) -> XParse OtherPlay -> XParse ChxPlay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherPlay -> XParse OtherPlay
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-play") (XParse OtherPlay
parseOtherPlay))

-- | Smart constructor for 'PlayIpa'
mkPlayIpa :: String -> ChxPlay
mkPlayIpa :: String -> ChxPlay
mkPlayIpa String
a = String -> ChxPlay
PlayIpa String
a
-- | Smart constructor for 'PlayMute'
mkPlayMute :: Mute -> ChxPlay
mkPlayMute :: Mute -> ChxPlay
mkPlayMute Mute
a = Mute -> ChxPlay
PlayMute Mute
a
-- | Smart constructor for 'PlaySemiPitched'
mkPlaySemiPitched :: SemiPitched -> ChxPlay
mkPlaySemiPitched :: SemiPitched -> ChxPlay
mkPlaySemiPitched SemiPitched
a = SemiPitched -> ChxPlay
PlaySemiPitched SemiPitched
a
-- | Smart constructor for 'PlayOtherPlay'
mkPlayOtherPlay :: OtherPlay -> ChxPlay
mkPlayOtherPlay :: OtherPlay -> ChxPlay
mkPlayOtherPlay OtherPlay
a = OtherPlay -> ChxPlay
PlayOtherPlay OtherPlay
a

-- | @score-instrument@ /(choice)/
data ChxScoreInstrument = 
      ScoreInstrumentSolo {
          ChxScoreInstrument -> Empty
scoreInstrumentSolo :: Empty -- ^ /solo/ child element
       }
    | ScoreInstrumentEnsemble {
          ChxScoreInstrument -> PositiveIntegerOrEmpty
scoreInstrumentEnsemble :: PositiveIntegerOrEmpty -- ^ /ensemble/ child element
       }
    deriving (ChxScoreInstrument -> ChxScoreInstrument -> Bool
(ChxScoreInstrument -> ChxScoreInstrument -> Bool)
-> (ChxScoreInstrument -> ChxScoreInstrument -> Bool)
-> Eq ChxScoreInstrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxScoreInstrument -> ChxScoreInstrument -> Bool
$c/= :: ChxScoreInstrument -> ChxScoreInstrument -> Bool
== :: ChxScoreInstrument -> ChxScoreInstrument -> Bool
$c== :: ChxScoreInstrument -> ChxScoreInstrument -> Bool
Eq,Typeable,(forall x. ChxScoreInstrument -> Rep ChxScoreInstrument x)
-> (forall x. Rep ChxScoreInstrument x -> ChxScoreInstrument)
-> Generic ChxScoreInstrument
forall x. Rep ChxScoreInstrument x -> ChxScoreInstrument
forall x. ChxScoreInstrument -> Rep ChxScoreInstrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxScoreInstrument x -> ChxScoreInstrument
$cfrom :: forall x. ChxScoreInstrument -> Rep ChxScoreInstrument x
Generic,Int -> ChxScoreInstrument -> ShowS
[ChxScoreInstrument] -> ShowS
ChxScoreInstrument -> String
(Int -> ChxScoreInstrument -> ShowS)
-> (ChxScoreInstrument -> String)
-> ([ChxScoreInstrument] -> ShowS)
-> Show ChxScoreInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxScoreInstrument] -> ShowS
$cshowList :: [ChxScoreInstrument] -> ShowS
show :: ChxScoreInstrument -> String
$cshow :: ChxScoreInstrument -> String
showsPrec :: Int -> ChxScoreInstrument -> ShowS
$cshowsPrec :: Int -> ChxScoreInstrument -> ShowS
Show)
instance EmitXml ChxScoreInstrument where
    emitXml :: ChxScoreInstrument -> XmlRep
emitXml (ScoreInstrumentSolo Empty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"solo" Maybe String
forall a. Maybe a
Nothing) (Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Empty
a)])
    emitXml (ScoreInstrumentEnsemble PositiveIntegerOrEmpty
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"ensemble" Maybe String
forall a. Maybe a
Nothing) (PositiveIntegerOrEmpty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveIntegerOrEmpty
a)])
parseChxScoreInstrument :: P.XParse ChxScoreInstrument
parseChxScoreInstrument :: XParse ChxScoreInstrument
parseChxScoreInstrument = 
      Empty -> ChxScoreInstrument
ScoreInstrumentSolo
        (Empty -> ChxScoreInstrument)
-> XParse Empty -> XParse ChxScoreInstrument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"solo") (XParse Empty
parseEmpty))
      XParse ChxScoreInstrument
-> XParse ChxScoreInstrument -> XParse ChxScoreInstrument
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PositiveIntegerOrEmpty -> ChxScoreInstrument
ScoreInstrumentEnsemble
        (PositiveIntegerOrEmpty -> ChxScoreInstrument)
-> XParse PositiveIntegerOrEmpty -> XParse ChxScoreInstrument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName
-> XParse PositiveIntegerOrEmpty -> XParse PositiveIntegerOrEmpty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"ensemble") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveIntegerOrEmpty)
-> XParse PositiveIntegerOrEmpty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveIntegerOrEmpty
parsePositiveIntegerOrEmpty))

-- | Smart constructor for 'ScoreInstrumentSolo'
mkScoreInstrumentSolo :: Empty -> ChxScoreInstrument
mkScoreInstrumentSolo :: Empty -> ChxScoreInstrument
mkScoreInstrumentSolo Empty
a = Empty -> ChxScoreInstrument
ScoreInstrumentSolo Empty
a
-- | Smart constructor for 'ScoreInstrumentEnsemble'
mkScoreInstrumentEnsemble :: PositiveIntegerOrEmpty -> ChxScoreInstrument
mkScoreInstrumentEnsemble :: PositiveIntegerOrEmpty -> ChxScoreInstrument
mkScoreInstrumentEnsemble PositiveIntegerOrEmpty
a = PositiveIntegerOrEmpty -> ChxScoreInstrument
ScoreInstrumentEnsemble PositiveIntegerOrEmpty
a

-- | @technical@ /(choice)/
data ChxTechnical = 
      TechnicalUpBow {
          ChxTechnical -> EmptyPlacement
technicalUpBow :: EmptyPlacement -- ^ /up-bow/ child element
       }
    | TechnicalDownBow {
          ChxTechnical -> EmptyPlacement
technicalDownBow :: EmptyPlacement -- ^ /down-bow/ child element
       }
    | TechnicalHarmonic {
          ChxTechnical -> Harmonic
technicalHarmonic :: Harmonic -- ^ /harmonic/ child element
       }
    | TechnicalOpenString {
          ChxTechnical -> EmptyPlacement
technicalOpenString :: EmptyPlacement -- ^ /open-string/ child element
       }
    | TechnicalThumbPosition {
          ChxTechnical -> EmptyPlacement
technicalThumbPosition :: EmptyPlacement -- ^ /thumb-position/ child element
       }
    | TechnicalFingering {
          ChxTechnical -> Fingering
technicalFingering :: Fingering -- ^ /fingering/ child element
       }
    | TechnicalPluck {
          ChxTechnical -> PlacementText
technicalPluck :: PlacementText -- ^ /pluck/ child element
       }
    | TechnicalDoubleTongue {
          ChxTechnical -> EmptyPlacement
technicalDoubleTongue :: EmptyPlacement -- ^ /double-tongue/ child element
       }
    | TechnicalTripleTongue {
          ChxTechnical -> EmptyPlacement
technicalTripleTongue :: EmptyPlacement -- ^ /triple-tongue/ child element
       }
    | TechnicalStopped {
          ChxTechnical -> EmptyPlacementSmufl
technicalStopped :: EmptyPlacementSmufl -- ^ /stopped/ child element
       }
    | TechnicalSnapPizzicato {
          ChxTechnical -> EmptyPlacement
technicalSnapPizzicato :: EmptyPlacement -- ^ /snap-pizzicato/ child element
       }
    | TechnicalFret {
          ChxTechnical -> Fret
technicalFret :: Fret -- ^ /fret/ child element
       }
    | TechnicalString {
          ChxTechnical -> CmpString
technicalString :: CmpString -- ^ /string/ child element
       }
    | TechnicalHammerOn {
          ChxTechnical -> HammerOnPullOff
technicalHammerOn :: HammerOnPullOff -- ^ /hammer-on/ child element
       }
    | TechnicalPullOff {
          ChxTechnical -> HammerOnPullOff
technicalPullOff :: HammerOnPullOff -- ^ /pull-off/ child element
       }
    | TechnicalBend {
          ChxTechnical -> Bend
technicalBend :: Bend -- ^ /bend/ child element
       }
    | TechnicalTap {
          ChxTechnical -> Tap
technicalTap :: Tap -- ^ /tap/ child element
       }
    | TechnicalHeel {
          ChxTechnical -> HeelToe
technicalHeel :: HeelToe -- ^ /heel/ child element
       }
    | TechnicalToe {
          ChxTechnical -> HeelToe
technicalToe :: HeelToe -- ^ /toe/ child element
       }
    | TechnicalFingernails {
          ChxTechnical -> EmptyPlacement
technicalFingernails :: EmptyPlacement -- ^ /fingernails/ child element
       }
    | TechnicalHole {
          ChxTechnical -> Hole
technicalHole :: Hole -- ^ /hole/ child element
       }
    | TechnicalArrow {
          ChxTechnical -> Arrow
technicalArrow :: Arrow -- ^ /arrow/ child element
       }
    | TechnicalHandbell {
          ChxTechnical -> Handbell
technicalHandbell :: Handbell -- ^ /handbell/ child element
       }
    | TechnicalBrassBend {
          ChxTechnical -> EmptyPlacement
technicalBrassBend :: EmptyPlacement -- ^ /brass-bend/ child element
       }
    | TechnicalFlip {
          ChxTechnical -> EmptyPlacement
technicalFlip :: EmptyPlacement -- ^ /flip/ child element
       }
    | TechnicalSmear {
          ChxTechnical -> EmptyPlacement
technicalSmear :: EmptyPlacement -- ^ /smear/ child element
       }
    | TechnicalOpen {
          ChxTechnical -> EmptyPlacementSmufl
technicalOpen :: EmptyPlacementSmufl -- ^ /open/ child element
       }
    | TechnicalHalfMuted {
          ChxTechnical -> EmptyPlacementSmufl
technicalHalfMuted :: EmptyPlacementSmufl -- ^ /half-muted/ child element
       }
    | TechnicalHarmonMute {
          ChxTechnical -> HarmonMute
technicalHarmonMute :: HarmonMute -- ^ /harmon-mute/ child element
       }
    | TechnicalGolpe {
          ChxTechnical -> EmptyPlacement
technicalGolpe :: EmptyPlacement -- ^ /golpe/ child element
       }
    | TechnicalOtherTechnical {
          ChxTechnical -> OtherPlacementText
technicalOtherTechnical :: OtherPlacementText -- ^ /other-technical/ child element
       }
    deriving (ChxTechnical -> ChxTechnical -> Bool
(ChxTechnical -> ChxTechnical -> Bool)
-> (ChxTechnical -> ChxTechnical -> Bool) -> Eq ChxTechnical
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxTechnical -> ChxTechnical -> Bool
$c/= :: ChxTechnical -> ChxTechnical -> Bool
== :: ChxTechnical -> ChxTechnical -> Bool
$c== :: ChxTechnical -> ChxTechnical -> Bool
Eq,Typeable,(forall x. ChxTechnical -> Rep ChxTechnical x)
-> (forall x. Rep ChxTechnical x -> ChxTechnical)
-> Generic ChxTechnical
forall x. Rep ChxTechnical x -> ChxTechnical
forall x. ChxTechnical -> Rep ChxTechnical x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxTechnical x -> ChxTechnical
$cfrom :: forall x. ChxTechnical -> Rep ChxTechnical x
Generic,Int -> ChxTechnical -> ShowS
[ChxTechnical] -> ShowS
ChxTechnical -> String
(Int -> ChxTechnical -> ShowS)
-> (ChxTechnical -> String)
-> ([ChxTechnical] -> ShowS)
-> Show ChxTechnical
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxTechnical] -> ShowS
$cshowList :: [ChxTechnical] -> ShowS
show :: ChxTechnical -> String
$cshow :: ChxTechnical -> String
showsPrec :: Int -> ChxTechnical -> ShowS
$cshowsPrec :: Int -> ChxTechnical -> ShowS
Show)
instance EmitXml ChxTechnical where
    emitXml :: ChxTechnical -> XmlRep
emitXml (TechnicalUpBow EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"up-bow" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalDownBow EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"down-bow" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalHarmonic Harmonic
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"harmonic" Maybe String
forall a. Maybe a
Nothing) (Harmonic -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Harmonic
a)])
    emitXml (TechnicalOpenString EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"open-string" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalThumbPosition EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"thumb-position" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalFingering Fingering
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fingering" Maybe String
forall a. Maybe a
Nothing) (Fingering -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fingering
a)])
    emitXml (TechnicalPluck PlacementText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pluck" Maybe String
forall a. Maybe a
Nothing) (PlacementText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PlacementText
a)])
    emitXml (TechnicalDoubleTongue EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"double-tongue" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalTripleTongue EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"triple-tongue" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalStopped EmptyPlacementSmufl
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"stopped" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacementSmufl -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacementSmufl
a)])
    emitXml (TechnicalSnapPizzicato EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"snap-pizzicato" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalFret Fret
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fret" Maybe String
forall a. Maybe a
Nothing) (Fret -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fret
a)])
    emitXml (TechnicalString CmpString
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"string" Maybe String
forall a. Maybe a
Nothing) (CmpString -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CmpString
a)])
    emitXml (TechnicalHammerOn HammerOnPullOff
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"hammer-on" Maybe String
forall a. Maybe a
Nothing) (HammerOnPullOff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HammerOnPullOff
a)])
    emitXml (TechnicalPullOff HammerOnPullOff
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"pull-off" Maybe String
forall a. Maybe a
Nothing) (HammerOnPullOff -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HammerOnPullOff
a)])
    emitXml (TechnicalBend Bend
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bend" Maybe String
forall a. Maybe a
Nothing) (Bend -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Bend
a)])
    emitXml (TechnicalTap Tap
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tap" Maybe String
forall a. Maybe a
Nothing) (Tap -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tap
a)])
    emitXml (TechnicalHeel HeelToe
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"heel" Maybe String
forall a. Maybe a
Nothing) (HeelToe -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HeelToe
a)])
    emitXml (TechnicalToe HeelToe
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"toe" Maybe String
forall a. Maybe a
Nothing) (HeelToe -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HeelToe
a)])
    emitXml (TechnicalFingernails EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fingernails" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalHole Hole
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"hole" Maybe String
forall a. Maybe a
Nothing) (Hole -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Hole
a)])
    emitXml (TechnicalArrow Arrow
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"arrow" Maybe String
forall a. Maybe a
Nothing) (Arrow -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Arrow
a)])
    emitXml (TechnicalHandbell Handbell
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"handbell" Maybe String
forall a. Maybe a
Nothing) (Handbell -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Handbell
a)])
    emitXml (TechnicalBrassBend EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"brass-bend" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalFlip EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"flip" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalSmear EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"smear" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalOpen EmptyPlacementSmufl
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"open" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacementSmufl -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacementSmufl
a)])
    emitXml (TechnicalHalfMuted EmptyPlacementSmufl
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"half-muted" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacementSmufl -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacementSmufl
a)])
    emitXml (TechnicalHarmonMute HarmonMute
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"harmon-mute" Maybe String
forall a. Maybe a
Nothing) (HarmonMute -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml HarmonMute
a)])
    emitXml (TechnicalGolpe EmptyPlacement
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"golpe" Maybe String
forall a. Maybe a
Nothing) (EmptyPlacement -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml EmptyPlacement
a)])
    emitXml (TechnicalOtherTechnical OtherPlacementText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"other-technical" Maybe String
forall a. Maybe a
Nothing) (OtherPlacementText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml OtherPlacementText
a)])
parseChxTechnical :: P.XParse ChxTechnical
parseChxTechnical :: XParse ChxTechnical
parseChxTechnical = 
      EmptyPlacement -> ChxTechnical
TechnicalUpBow
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"up-bow") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalDownBow
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"down-bow") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Harmonic -> ChxTechnical
TechnicalHarmonic
        (Harmonic -> ChxTechnical)
-> XParse Harmonic -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Harmonic -> XParse Harmonic
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"harmonic") (XParse Harmonic
parseHarmonic))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalOpenString
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"open-string") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalThumbPosition
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"thumb-position") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Fingering -> ChxTechnical
TechnicalFingering
        (Fingering -> ChxTechnical)
-> XParse Fingering -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Fingering -> XParse Fingering
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fingering") (XParse Fingering
parseFingering))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PlacementText -> ChxTechnical
TechnicalPluck
        (PlacementText -> ChxTechnical)
-> XParse PlacementText -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PlacementText -> XParse PlacementText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pluck") (XParse PlacementText
parsePlacementText))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalDoubleTongue
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"double-tongue") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalTripleTongue
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"triple-tongue") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacementSmufl -> ChxTechnical
TechnicalStopped
        (EmptyPlacementSmufl -> ChxTechnical)
-> XParse EmptyPlacementSmufl -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacementSmufl -> XParse EmptyPlacementSmufl
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"stopped") (XParse EmptyPlacementSmufl
parseEmptyPlacementSmufl))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalSnapPizzicato
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"snap-pizzicato") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Fret -> ChxTechnical
TechnicalFret
        (Fret -> ChxTechnical) -> XParse Fret -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Fret -> XParse Fret
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fret") (XParse Fret
parseFret))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CmpString -> ChxTechnical
TechnicalString
        (CmpString -> ChxTechnical)
-> XParse CmpString -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse CmpString -> XParse CmpString
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"string") (XParse CmpString
parseCmpString))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HammerOnPullOff -> ChxTechnical
TechnicalHammerOn
        (HammerOnPullOff -> ChxTechnical)
-> XParse HammerOnPullOff -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HammerOnPullOff -> XParse HammerOnPullOff
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"hammer-on") (XParse HammerOnPullOff
parseHammerOnPullOff))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HammerOnPullOff -> ChxTechnical
TechnicalPullOff
        (HammerOnPullOff -> ChxTechnical)
-> XParse HammerOnPullOff -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HammerOnPullOff -> XParse HammerOnPullOff
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"pull-off") (XParse HammerOnPullOff
parseHammerOnPullOff))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bend -> ChxTechnical
TechnicalBend
        (Bend -> ChxTechnical) -> XParse Bend -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Bend -> XParse Bend
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bend") (XParse Bend
parseBend))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tap -> ChxTechnical
TechnicalTap
        (Tap -> ChxTechnical) -> XParse Tap -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tap -> XParse Tap
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tap") (XParse Tap
parseTap))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HeelToe -> ChxTechnical
TechnicalHeel
        (HeelToe -> ChxTechnical) -> XParse HeelToe -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HeelToe -> XParse HeelToe
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"heel") (XParse HeelToe
parseHeelToe))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HeelToe -> ChxTechnical
TechnicalToe
        (HeelToe -> ChxTechnical) -> XParse HeelToe -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HeelToe -> XParse HeelToe
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"toe") (XParse HeelToe
parseHeelToe))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalFingernails
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fingernails") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Hole -> ChxTechnical
TechnicalHole
        (Hole -> ChxTechnical) -> XParse Hole -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Hole -> XParse Hole
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"hole") (XParse Hole
parseHole))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Arrow -> ChxTechnical
TechnicalArrow
        (Arrow -> ChxTechnical) -> XParse Arrow -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Arrow -> XParse Arrow
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"arrow") (XParse Arrow
parseArrow))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Handbell -> ChxTechnical
TechnicalHandbell
        (Handbell -> ChxTechnical)
-> XParse Handbell -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Handbell -> XParse Handbell
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"handbell") (XParse Handbell
parseHandbell))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalBrassBend
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"brass-bend") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalFlip
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"flip") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalSmear
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"smear") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacementSmufl -> ChxTechnical
TechnicalOpen
        (EmptyPlacementSmufl -> ChxTechnical)
-> XParse EmptyPlacementSmufl -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacementSmufl -> XParse EmptyPlacementSmufl
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"open") (XParse EmptyPlacementSmufl
parseEmptyPlacementSmufl))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacementSmufl -> ChxTechnical
TechnicalHalfMuted
        (EmptyPlacementSmufl -> ChxTechnical)
-> XParse EmptyPlacementSmufl -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacementSmufl -> XParse EmptyPlacementSmufl
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"half-muted") (XParse EmptyPlacementSmufl
parseEmptyPlacementSmufl))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HarmonMute -> ChxTechnical
TechnicalHarmonMute
        (HarmonMute -> ChxTechnical)
-> XParse HarmonMute -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse HarmonMute -> XParse HarmonMute
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"harmon-mute") (XParse HarmonMute
parseHarmonMute))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyPlacement -> ChxTechnical
TechnicalGolpe
        (EmptyPlacement -> ChxTechnical)
-> XParse EmptyPlacement -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse EmptyPlacement -> XParse EmptyPlacement
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"golpe") (XParse EmptyPlacement
parseEmptyPlacement))
      XParse ChxTechnical -> XParse ChxTechnical -> XParse ChxTechnical
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OtherPlacementText -> ChxTechnical
TechnicalOtherTechnical
        (OtherPlacementText -> ChxTechnical)
-> XParse OtherPlacementText -> XParse ChxTechnical
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse OtherPlacementText -> XParse OtherPlacementText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"other-technical") (XParse OtherPlacementText
parseOtherPlacementText))

-- | Smart constructor for 'TechnicalUpBow'
mkTechnicalUpBow :: EmptyPlacement -> ChxTechnical
mkTechnicalUpBow :: EmptyPlacement -> ChxTechnical
mkTechnicalUpBow EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalUpBow EmptyPlacement
a
-- | Smart constructor for 'TechnicalDownBow'
mkTechnicalDownBow :: EmptyPlacement -> ChxTechnical
mkTechnicalDownBow :: EmptyPlacement -> ChxTechnical
mkTechnicalDownBow EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalDownBow EmptyPlacement
a
-- | Smart constructor for 'TechnicalHarmonic'
mkTechnicalHarmonic :: Harmonic -> ChxTechnical
mkTechnicalHarmonic :: Harmonic -> ChxTechnical
mkTechnicalHarmonic Harmonic
a = Harmonic -> ChxTechnical
TechnicalHarmonic Harmonic
a
-- | Smart constructor for 'TechnicalOpenString'
mkTechnicalOpenString :: EmptyPlacement -> ChxTechnical
mkTechnicalOpenString :: EmptyPlacement -> ChxTechnical
mkTechnicalOpenString EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalOpenString EmptyPlacement
a
-- | Smart constructor for 'TechnicalThumbPosition'
mkTechnicalThumbPosition :: EmptyPlacement -> ChxTechnical
mkTechnicalThumbPosition :: EmptyPlacement -> ChxTechnical
mkTechnicalThumbPosition EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalThumbPosition EmptyPlacement
a
-- | Smart constructor for 'TechnicalFingering'
mkTechnicalFingering :: Fingering -> ChxTechnical
mkTechnicalFingering :: Fingering -> ChxTechnical
mkTechnicalFingering Fingering
a = Fingering -> ChxTechnical
TechnicalFingering Fingering
a
-- | Smart constructor for 'TechnicalPluck'
mkTechnicalPluck :: PlacementText -> ChxTechnical
mkTechnicalPluck :: PlacementText -> ChxTechnical
mkTechnicalPluck PlacementText
a = PlacementText -> ChxTechnical
TechnicalPluck PlacementText
a
-- | Smart constructor for 'TechnicalDoubleTongue'
mkTechnicalDoubleTongue :: EmptyPlacement -> ChxTechnical
mkTechnicalDoubleTongue :: EmptyPlacement -> ChxTechnical
mkTechnicalDoubleTongue EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalDoubleTongue EmptyPlacement
a
-- | Smart constructor for 'TechnicalTripleTongue'
mkTechnicalTripleTongue :: EmptyPlacement -> ChxTechnical
mkTechnicalTripleTongue :: EmptyPlacement -> ChxTechnical
mkTechnicalTripleTongue EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalTripleTongue EmptyPlacement
a
-- | Smart constructor for 'TechnicalStopped'
mkTechnicalStopped :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalStopped :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalStopped EmptyPlacementSmufl
a = EmptyPlacementSmufl -> ChxTechnical
TechnicalStopped EmptyPlacementSmufl
a
-- | Smart constructor for 'TechnicalSnapPizzicato'
mkTechnicalSnapPizzicato :: EmptyPlacement -> ChxTechnical
mkTechnicalSnapPizzicato :: EmptyPlacement -> ChxTechnical
mkTechnicalSnapPizzicato EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalSnapPizzicato EmptyPlacement
a
-- | Smart constructor for 'TechnicalFret'
mkTechnicalFret :: Fret -> ChxTechnical
mkTechnicalFret :: Fret -> ChxTechnical
mkTechnicalFret Fret
a = Fret -> ChxTechnical
TechnicalFret Fret
a
-- | Smart constructor for 'TechnicalString'
mkTechnicalString :: CmpString -> ChxTechnical
mkTechnicalString :: CmpString -> ChxTechnical
mkTechnicalString CmpString
a = CmpString -> ChxTechnical
TechnicalString CmpString
a
-- | Smart constructor for 'TechnicalHammerOn'
mkTechnicalHammerOn :: HammerOnPullOff -> ChxTechnical
mkTechnicalHammerOn :: HammerOnPullOff -> ChxTechnical
mkTechnicalHammerOn HammerOnPullOff
a = HammerOnPullOff -> ChxTechnical
TechnicalHammerOn HammerOnPullOff
a
-- | Smart constructor for 'TechnicalPullOff'
mkTechnicalPullOff :: HammerOnPullOff -> ChxTechnical
mkTechnicalPullOff :: HammerOnPullOff -> ChxTechnical
mkTechnicalPullOff HammerOnPullOff
a = HammerOnPullOff -> ChxTechnical
TechnicalPullOff HammerOnPullOff
a
-- | Smart constructor for 'TechnicalBend'
mkTechnicalBend :: Bend -> ChxTechnical
mkTechnicalBend :: Bend -> ChxTechnical
mkTechnicalBend Bend
a = Bend -> ChxTechnical
TechnicalBend Bend
a
-- | Smart constructor for 'TechnicalTap'
mkTechnicalTap :: Tap -> ChxTechnical
mkTechnicalTap :: Tap -> ChxTechnical
mkTechnicalTap Tap
a = Tap -> ChxTechnical
TechnicalTap Tap
a
-- | Smart constructor for 'TechnicalHeel'
mkTechnicalHeel :: HeelToe -> ChxTechnical
mkTechnicalHeel :: HeelToe -> ChxTechnical
mkTechnicalHeel HeelToe
a = HeelToe -> ChxTechnical
TechnicalHeel HeelToe
a
-- | Smart constructor for 'TechnicalToe'
mkTechnicalToe :: HeelToe -> ChxTechnical
mkTechnicalToe :: HeelToe -> ChxTechnical
mkTechnicalToe HeelToe
a = HeelToe -> ChxTechnical
TechnicalToe HeelToe
a
-- | Smart constructor for 'TechnicalFingernails'
mkTechnicalFingernails :: EmptyPlacement -> ChxTechnical
mkTechnicalFingernails :: EmptyPlacement -> ChxTechnical
mkTechnicalFingernails EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalFingernails EmptyPlacement
a
-- | Smart constructor for 'TechnicalHole'
mkTechnicalHole :: Hole -> ChxTechnical
mkTechnicalHole :: Hole -> ChxTechnical
mkTechnicalHole Hole
a = Hole -> ChxTechnical
TechnicalHole Hole
a
-- | Smart constructor for 'TechnicalArrow'
mkTechnicalArrow :: Arrow -> ChxTechnical
mkTechnicalArrow :: Arrow -> ChxTechnical
mkTechnicalArrow Arrow
a = Arrow -> ChxTechnical
TechnicalArrow Arrow
a
-- | Smart constructor for 'TechnicalHandbell'
mkTechnicalHandbell :: Handbell -> ChxTechnical
mkTechnicalHandbell :: Handbell -> ChxTechnical
mkTechnicalHandbell Handbell
a = Handbell -> ChxTechnical
TechnicalHandbell Handbell
a
-- | Smart constructor for 'TechnicalBrassBend'
mkTechnicalBrassBend :: EmptyPlacement -> ChxTechnical
mkTechnicalBrassBend :: EmptyPlacement -> ChxTechnical
mkTechnicalBrassBend EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalBrassBend EmptyPlacement
a
-- | Smart constructor for 'TechnicalFlip'
mkTechnicalFlip :: EmptyPlacement -> ChxTechnical
mkTechnicalFlip :: EmptyPlacement -> ChxTechnical
mkTechnicalFlip EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalFlip EmptyPlacement
a
-- | Smart constructor for 'TechnicalSmear'
mkTechnicalSmear :: EmptyPlacement -> ChxTechnical
mkTechnicalSmear :: EmptyPlacement -> ChxTechnical
mkTechnicalSmear EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalSmear EmptyPlacement
a
-- | Smart constructor for 'TechnicalOpen'
mkTechnicalOpen :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalOpen :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalOpen EmptyPlacementSmufl
a = EmptyPlacementSmufl -> ChxTechnical
TechnicalOpen EmptyPlacementSmufl
a
-- | Smart constructor for 'TechnicalHalfMuted'
mkTechnicalHalfMuted :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalHalfMuted :: EmptyPlacementSmufl -> ChxTechnical
mkTechnicalHalfMuted EmptyPlacementSmufl
a = EmptyPlacementSmufl -> ChxTechnical
TechnicalHalfMuted EmptyPlacementSmufl
a
-- | Smart constructor for 'TechnicalHarmonMute'
mkTechnicalHarmonMute :: HarmonMute -> ChxTechnical
mkTechnicalHarmonMute :: HarmonMute -> ChxTechnical
mkTechnicalHarmonMute HarmonMute
a = HarmonMute -> ChxTechnical
TechnicalHarmonMute HarmonMute
a
-- | Smart constructor for 'TechnicalGolpe'
mkTechnicalGolpe :: EmptyPlacement -> ChxTechnical
mkTechnicalGolpe :: EmptyPlacement -> ChxTechnical
mkTechnicalGolpe EmptyPlacement
a = EmptyPlacement -> ChxTechnical
TechnicalGolpe EmptyPlacement
a
-- | Smart constructor for 'TechnicalOtherTechnical'
mkTechnicalOtherTechnical :: OtherPlacementText -> ChxTechnical
mkTechnicalOtherTechnical :: OtherPlacementText -> ChxTechnical
mkTechnicalOtherTechnical OtherPlacementText
a = OtherPlacementText -> ChxTechnical
TechnicalOtherTechnical OtherPlacementText
a

-- | @time@ /(choice)/
data ChxTime = 
      TimeTimeSignature {
          ChxTime -> [TimeSignature]
timeTimeSignature :: [TimeSignature]
        , ChxTime -> Maybe Interchangeable
timeInterchangeable :: (Maybe Interchangeable) -- ^ /interchangeable/ child element
       }
    | TimeSenzaMisura {
          ChxTime -> String
timeSenzaMisura :: String -- ^ /senza-misura/ child element
       }
    deriving (ChxTime -> ChxTime -> Bool
(ChxTime -> ChxTime -> Bool)
-> (ChxTime -> ChxTime -> Bool) -> Eq ChxTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChxTime -> ChxTime -> Bool
$c/= :: ChxTime -> ChxTime -> Bool
== :: ChxTime -> ChxTime -> Bool
$c== :: ChxTime -> ChxTime -> Bool
Eq,Typeable,(forall x. ChxTime -> Rep ChxTime x)
-> (forall x. Rep ChxTime x -> ChxTime) -> Generic ChxTime
forall x. Rep ChxTime x -> ChxTime
forall x. ChxTime -> Rep ChxTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChxTime x -> ChxTime
$cfrom :: forall x. ChxTime -> Rep ChxTime x
Generic,Int -> ChxTime -> ShowS
[ChxTime] -> ShowS
ChxTime -> String
(Int -> ChxTime -> ShowS)
-> (ChxTime -> String) -> ([ChxTime] -> ShowS) -> Show ChxTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChxTime] -> ShowS
$cshowList :: [ChxTime] -> ShowS
show :: ChxTime -> String
$cshow :: ChxTime -> String
showsPrec :: Int -> ChxTime -> ShowS
$cshowsPrec :: Int -> ChxTime -> ShowS
Show)
instance EmitXml ChxTime where
    emitXml :: ChxTime -> XmlRep
emitXml (TimeTimeSignature [TimeSignature]
a Maybe Interchangeable
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([[TimeSignature] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [TimeSignature]
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (Interchangeable -> XmlRep) -> Maybe Interchangeable -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"interchangeable" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Interchangeable -> XmlRep) -> Interchangeable -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Interchangeable -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Interchangeable
b])
    emitXml (TimeSenzaMisura String
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"senza-misura" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)])
parseChxTime :: P.XParse ChxTime
parseChxTime :: XParse ChxTime
parseChxTime = 
      [TimeSignature] -> Maybe Interchangeable -> ChxTime
TimeTimeSignature
        ([TimeSignature] -> Maybe Interchangeable -> ChxTime)
-> XParse [TimeSignature]
-> XParse (Maybe Interchangeable -> ChxTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse TimeSignature -> XParse [TimeSignature]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse TimeSignature
parseTimeSignature)
        XParse (Maybe Interchangeable -> ChxTime)
-> XParse (Maybe Interchangeable) -> XParse ChxTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Interchangeable -> XParse (Maybe Interchangeable)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Interchangeable -> XParse Interchangeable
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"interchangeable") (XParse Interchangeable
parseInterchangeable))
      XParse ChxTime -> XParse ChxTime -> XParse ChxTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ChxTime
TimeSenzaMisura
        (String -> ChxTime) -> XParse String -> XParse ChxTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"senza-misura") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'TimeTimeSignature'
mkTimeTimeSignature :: ChxTime
mkTimeTimeSignature :: ChxTime
mkTimeTimeSignature = [TimeSignature] -> Maybe Interchangeable -> ChxTime
TimeTimeSignature [] Maybe Interchangeable
forall a. Maybe a
Nothing
-- | Smart constructor for 'TimeSenzaMisura'
mkTimeSenzaMisura :: String -> ChxTime
mkTimeSenzaMisura :: String -> ChxTime
mkTimeSenzaMisura String
a = String -> ChxTime
TimeSenzaMisura String
a

-- | @credit@ /(sequence)/
data SeqCredit = 
      SeqCredit {
          SeqCredit -> [Link]
seqcreditLink :: [Link] -- ^ /link/ child element
        , SeqCredit -> [Bookmark]
seqcreditBookmark :: [Bookmark] -- ^ /bookmark/ child element
        , SeqCredit -> ChxCredit1
seqcreditCredit :: ChxCredit1
       }
    deriving (SeqCredit -> SeqCredit -> Bool
(SeqCredit -> SeqCredit -> Bool)
-> (SeqCredit -> SeqCredit -> Bool) -> Eq SeqCredit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqCredit -> SeqCredit -> Bool
$c/= :: SeqCredit -> SeqCredit -> Bool
== :: SeqCredit -> SeqCredit -> Bool
$c== :: SeqCredit -> SeqCredit -> Bool
Eq,Typeable,(forall x. SeqCredit -> Rep SeqCredit x)
-> (forall x. Rep SeqCredit x -> SeqCredit) -> Generic SeqCredit
forall x. Rep SeqCredit x -> SeqCredit
forall x. SeqCredit -> Rep SeqCredit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqCredit x -> SeqCredit
$cfrom :: forall x. SeqCredit -> Rep SeqCredit x
Generic,Int -> SeqCredit -> ShowS
[SeqCredit] -> ShowS
SeqCredit -> String
(Int -> SeqCredit -> ShowS)
-> (SeqCredit -> String)
-> ([SeqCredit] -> ShowS)
-> Show SeqCredit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqCredit] -> ShowS
$cshowList :: [SeqCredit] -> ShowS
show :: SeqCredit -> String
$cshow :: SeqCredit -> String
showsPrec :: Int -> SeqCredit -> ShowS
$cshowsPrec :: Int -> SeqCredit -> ShowS
Show)
instance EmitXml SeqCredit where
    emitXml :: SeqCredit -> XmlRep
emitXml (SeqCredit [Link]
a [Bookmark]
b ChxCredit1
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ((Link -> XmlRep) -> [Link] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"link" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Link -> XmlRep) -> Link -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Link -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Link]
a [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Bookmark -> XmlRep) -> [Bookmark] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bookmark" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Bookmark -> XmlRep) -> Bookmark -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Bookmark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Bookmark]
b [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [ChxCredit1 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxCredit1
c])
parseSeqCredit :: P.XParse SeqCredit
parseSeqCredit :: XParse SeqCredit
parseSeqCredit = 
      [Link] -> [Bookmark] -> ChxCredit1 -> SeqCredit
SeqCredit
        ([Link] -> [Bookmark] -> ChxCredit1 -> SeqCredit)
-> XParse [Link] -> XParse ([Bookmark] -> ChxCredit1 -> SeqCredit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Link -> XParse [Link]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Link -> XParse Link
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"link") (XParse Link
parseLink))
        XParse ([Bookmark] -> ChxCredit1 -> SeqCredit)
-> XParse [Bookmark] -> XParse (ChxCredit1 -> SeqCredit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Bookmark -> XParse [Bookmark]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Bookmark -> XParse Bookmark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bookmark") (XParse Bookmark
parseBookmark))
        XParse (ChxCredit1 -> SeqCredit)
-> XParse ChxCredit1 -> XParse SeqCredit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse ChxCredit1
parseChxCredit1

-- | Smart constructor for 'SeqCredit'
mkSeqCredit :: ChxCredit1 -> SeqCredit
mkSeqCredit :: ChxCredit1 -> SeqCredit
mkSeqCredit ChxCredit1
c = [Link] -> [Bookmark] -> ChxCredit1 -> SeqCredit
SeqCredit [] [] ChxCredit1
c

-- | @lyric@ /(sequence)/
data SeqLyric0 = 
      SeqLyric0 {
          SeqLyric0 -> Elision
lyricElision :: Elision -- ^ /elision/ child element
        , SeqLyric0 -> Maybe Syllabic
seqlyricSyllabic :: (Maybe Syllabic) -- ^ /syllabic/ child element
       }
    deriving (SeqLyric0 -> SeqLyric0 -> Bool
(SeqLyric0 -> SeqLyric0 -> Bool)
-> (SeqLyric0 -> SeqLyric0 -> Bool) -> Eq SeqLyric0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqLyric0 -> SeqLyric0 -> Bool
$c/= :: SeqLyric0 -> SeqLyric0 -> Bool
== :: SeqLyric0 -> SeqLyric0 -> Bool
$c== :: SeqLyric0 -> SeqLyric0 -> Bool
Eq,Typeable,(forall x. SeqLyric0 -> Rep SeqLyric0 x)
-> (forall x. Rep SeqLyric0 x -> SeqLyric0) -> Generic SeqLyric0
forall x. Rep SeqLyric0 x -> SeqLyric0
forall x. SeqLyric0 -> Rep SeqLyric0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqLyric0 x -> SeqLyric0
$cfrom :: forall x. SeqLyric0 -> Rep SeqLyric0 x
Generic,Int -> SeqLyric0 -> ShowS
[SeqLyric0] -> ShowS
SeqLyric0 -> String
(Int -> SeqLyric0 -> ShowS)
-> (SeqLyric0 -> String)
-> ([SeqLyric0] -> ShowS)
-> Show SeqLyric0
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqLyric0] -> ShowS
$cshowList :: [SeqLyric0] -> ShowS
show :: SeqLyric0 -> String
$cshow :: SeqLyric0 -> String
showsPrec :: Int -> SeqLyric0 -> ShowS
$cshowsPrec :: Int -> SeqLyric0 -> ShowS
Show)
instance EmitXml SeqLyric0 where
    emitXml :: SeqLyric0 -> XmlRep
emitXml (SeqLyric0 Elision
a Maybe Syllabic
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"elision" Maybe String
forall a. Maybe a
Nothing) (Elision -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Elision
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Syllabic -> XmlRep) -> Maybe Syllabic -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"syllabic" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Syllabic -> XmlRep) -> Syllabic -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Syllabic -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Syllabic
b])
parseSeqLyric0 :: P.XParse SeqLyric0
parseSeqLyric0 :: XParse SeqLyric0
parseSeqLyric0 = 
      Elision -> Maybe Syllabic -> SeqLyric0
SeqLyric0
        (Elision -> Maybe Syllabic -> SeqLyric0)
-> XParse Elision -> XParse (Maybe Syllabic -> SeqLyric0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Elision -> XParse Elision
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"elision") (XParse Elision
parseElision))
        XParse (Maybe Syllabic -> SeqLyric0)
-> XParse (Maybe Syllabic) -> XParse SeqLyric0
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Syllabic -> XParse (Maybe Syllabic)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Syllabic -> XParse Syllabic
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"syllabic") (XParse String
P.xtext XParse String -> (String -> XParse Syllabic) -> XParse Syllabic
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Syllabic
parseSyllabic))

-- | Smart constructor for 'SeqLyric0'
mkSeqLyric0 :: Elision -> SeqLyric0
mkSeqLyric0 :: Elision -> SeqLyric0
mkSeqLyric0 Elision
a = Elision -> Maybe Syllabic -> SeqLyric0
SeqLyric0 Elision
a Maybe Syllabic
forall a. Maybe a
Nothing

-- | @lyric@ /(sequence)/

-- mangled: 1
data SeqLyric = 
      SeqLyric {
          SeqLyric -> Maybe SeqLyric0
seqlyricLyric :: (Maybe SeqLyric0)
        , SeqLyric -> TextElementData
seqlyricText :: TextElementData -- ^ /text/ child element
       }
    deriving (SeqLyric -> SeqLyric -> Bool
(SeqLyric -> SeqLyric -> Bool)
-> (SeqLyric -> SeqLyric -> Bool) -> Eq SeqLyric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqLyric -> SeqLyric -> Bool
$c/= :: SeqLyric -> SeqLyric -> Bool
== :: SeqLyric -> SeqLyric -> Bool
$c== :: SeqLyric -> SeqLyric -> Bool
Eq,Typeable,(forall x. SeqLyric -> Rep SeqLyric x)
-> (forall x. Rep SeqLyric x -> SeqLyric) -> Generic SeqLyric
forall x. Rep SeqLyric x -> SeqLyric
forall x. SeqLyric -> Rep SeqLyric x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqLyric x -> SeqLyric
$cfrom :: forall x. SeqLyric -> Rep SeqLyric x
Generic,Int -> SeqLyric -> ShowS
[SeqLyric] -> ShowS
SeqLyric -> String
(Int -> SeqLyric -> ShowS)
-> (SeqLyric -> String) -> ([SeqLyric] -> ShowS) -> Show SeqLyric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqLyric] -> ShowS
$cshowList :: [SeqLyric] -> ShowS
show :: SeqLyric -> String
$cshow :: SeqLyric -> String
showsPrec :: Int -> SeqLyric -> ShowS
$cshowsPrec :: Int -> SeqLyric -> ShowS
Show)
instance EmitXml SeqLyric where
    emitXml :: SeqLyric -> XmlRep
emitXml (SeqLyric Maybe SeqLyric0
a TextElementData
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([Maybe SeqLyric0 -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe SeqLyric0
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"text" Maybe String
forall a. Maybe a
Nothing) (TextElementData -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml TextElementData
b)])
parseSeqLyric :: P.XParse SeqLyric
parseSeqLyric :: XParse SeqLyric
parseSeqLyric = 
      Maybe SeqLyric0 -> TextElementData -> SeqLyric
SeqLyric
        (Maybe SeqLyric0 -> TextElementData -> SeqLyric)
-> XParse (Maybe SeqLyric0) -> XParse (TextElementData -> SeqLyric)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SeqLyric0 -> XParse (Maybe SeqLyric0)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse SeqLyric0
parseSeqLyric0)
        XParse (TextElementData -> SeqLyric)
-> XParse TextElementData -> XParse SeqLyric
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse TextElementData -> XParse TextElementData
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"text") (XParse TextElementData
parseTextElementData))

-- | Smart constructor for 'SeqLyric'
mkSeqLyric :: TextElementData -> SeqLyric
mkSeqLyric :: TextElementData -> SeqLyric
mkSeqLyric TextElementData
b = Maybe SeqLyric0 -> TextElementData -> SeqLyric
SeqLyric Maybe SeqLyric0
forall a. Maybe a
Nothing TextElementData
b

-- | @metronome@ /(sequence)/
data SeqMetronome = 
      SeqMetronome {
          SeqMetronome -> String
metronomeMetronomeRelation :: String -- ^ /metronome-relation/ child element
        , SeqMetronome -> [MetronomeNote]
seqmetronomeMetronomeNote :: [MetronomeNote] -- ^ /metronome-note/ child element
       }
    deriving (SeqMetronome -> SeqMetronome -> Bool
(SeqMetronome -> SeqMetronome -> Bool)
-> (SeqMetronome -> SeqMetronome -> Bool) -> Eq SeqMetronome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqMetronome -> SeqMetronome -> Bool
$c/= :: SeqMetronome -> SeqMetronome -> Bool
== :: SeqMetronome -> SeqMetronome -> Bool
$c== :: SeqMetronome -> SeqMetronome -> Bool
Eq,Typeable,(forall x. SeqMetronome -> Rep SeqMetronome x)
-> (forall x. Rep SeqMetronome x -> SeqMetronome)
-> Generic SeqMetronome
forall x. Rep SeqMetronome x -> SeqMetronome
forall x. SeqMetronome -> Rep SeqMetronome x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqMetronome x -> SeqMetronome
$cfrom :: forall x. SeqMetronome -> Rep SeqMetronome x
Generic,Int -> SeqMetronome -> ShowS
[SeqMetronome] -> ShowS
SeqMetronome -> String
(Int -> SeqMetronome -> ShowS)
-> (SeqMetronome -> String)
-> ([SeqMetronome] -> ShowS)
-> Show SeqMetronome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqMetronome] -> ShowS
$cshowList :: [SeqMetronome] -> ShowS
show :: SeqMetronome -> String
$cshow :: SeqMetronome -> String
showsPrec :: Int -> SeqMetronome -> ShowS
$cshowsPrec :: Int -> SeqMetronome -> ShowS
Show)
instance EmitXml SeqMetronome where
    emitXml :: SeqMetronome -> XmlRep
emitXml (SeqMetronome String
a [MetronomeNote]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-relation" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (MetronomeNote -> XmlRep) -> [MetronomeNote] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"metronome-note" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MetronomeNote -> XmlRep) -> MetronomeNote -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MetronomeNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [MetronomeNote]
b)
parseSeqMetronome :: P.XParse SeqMetronome
parseSeqMetronome :: XParse SeqMetronome
parseSeqMetronome = 
      String -> [MetronomeNote] -> SeqMetronome
SeqMetronome
        (String -> [MetronomeNote] -> SeqMetronome)
-> XParse String -> XParse ([MetronomeNote] -> SeqMetronome)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-relation") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse ([MetronomeNote] -> SeqMetronome)
-> XParse [MetronomeNote] -> XParse SeqMetronome
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MetronomeNote -> XParse [MetronomeNote]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse MetronomeNote -> XParse MetronomeNote
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"metronome-note") (XParse MetronomeNote
parseMetronomeNote))

-- | Smart constructor for 'SeqMetronome'
mkSeqMetronome :: String -> SeqMetronome
mkSeqMetronome :: String -> SeqMetronome
mkSeqMetronome String
a = String -> [MetronomeNote] -> SeqMetronome
SeqMetronome String
a []

-- | @metronome-tuplet@ /(sequence)/
data SeqMetronomeTuplet = 
      SeqMetronomeTuplet {
          SeqMetronomeTuplet -> NoteTypeValue
metronomeTupletNormalType :: NoteTypeValue -- ^ /normal-type/ child element
        , SeqMetronomeTuplet -> [Empty]
metronomeTupletNormalDot :: [Empty] -- ^ /normal-dot/ child element
       }
    deriving (SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool
(SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool)
-> (SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool)
-> Eq SeqMetronomeTuplet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool
$c/= :: SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool
== :: SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool
$c== :: SeqMetronomeTuplet -> SeqMetronomeTuplet -> Bool
Eq,Typeable,(forall x. SeqMetronomeTuplet -> Rep SeqMetronomeTuplet x)
-> (forall x. Rep SeqMetronomeTuplet x -> SeqMetronomeTuplet)
-> Generic SeqMetronomeTuplet
forall x. Rep SeqMetronomeTuplet x -> SeqMetronomeTuplet
forall x. SeqMetronomeTuplet -> Rep SeqMetronomeTuplet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqMetronomeTuplet x -> SeqMetronomeTuplet
$cfrom :: forall x. SeqMetronomeTuplet -> Rep SeqMetronomeTuplet x
Generic,Int -> SeqMetronomeTuplet -> ShowS
[SeqMetronomeTuplet] -> ShowS
SeqMetronomeTuplet -> String
(Int -> SeqMetronomeTuplet -> ShowS)
-> (SeqMetronomeTuplet -> String)
-> ([SeqMetronomeTuplet] -> ShowS)
-> Show SeqMetronomeTuplet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqMetronomeTuplet] -> ShowS
$cshowList :: [SeqMetronomeTuplet] -> ShowS
show :: SeqMetronomeTuplet -> String
$cshow :: SeqMetronomeTuplet -> String
showsPrec :: Int -> SeqMetronomeTuplet -> ShowS
$cshowsPrec :: Int -> SeqMetronomeTuplet -> ShowS
Show)
instance EmitXml SeqMetronomeTuplet where
    emitXml :: SeqMetronomeTuplet -> XmlRep
emitXml (SeqMetronomeTuplet NoteTypeValue
a [Empty]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"normal-type" Maybe String
forall a. Maybe a
Nothing) (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Empty -> XmlRep) -> [Empty] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"normal-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Empty]
b)
parseSeqMetronomeTuplet :: P.XParse SeqMetronomeTuplet
parseSeqMetronomeTuplet :: XParse SeqMetronomeTuplet
parseSeqMetronomeTuplet = 
      NoteTypeValue -> [Empty] -> SeqMetronomeTuplet
SeqMetronomeTuplet
        (NoteTypeValue -> [Empty] -> SeqMetronomeTuplet)
-> XParse NoteTypeValue -> XParse ([Empty] -> SeqMetronomeTuplet)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NoteTypeValue -> XParse NoteTypeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"normal-type") (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue))
        XParse ([Empty] -> SeqMetronomeTuplet)
-> XParse [Empty] -> XParse SeqMetronomeTuplet
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse [Empty]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"normal-dot") (XParse Empty
parseEmpty))

-- | Smart constructor for 'SeqMetronomeTuplet'
mkSeqMetronomeTuplet :: NoteTypeValue -> SeqMetronomeTuplet
mkSeqMetronomeTuplet :: NoteTypeValue -> SeqMetronomeTuplet
mkSeqMetronomeTuplet NoteTypeValue
a = NoteTypeValue -> [Empty] -> SeqMetronomeTuplet
SeqMetronomeTuplet NoteTypeValue
a []

-- | @ornaments@ /(sequence)/
data SeqOrnaments = 
      SeqOrnaments {
          SeqOrnaments -> ChxOrnaments
seqornamentsOrnaments :: ChxOrnaments
        , SeqOrnaments -> [AccidentalMark]
ornamentsAccidentalMark :: [AccidentalMark] -- ^ /accidental-mark/ child element
       }
    deriving (SeqOrnaments -> SeqOrnaments -> Bool
(SeqOrnaments -> SeqOrnaments -> Bool)
-> (SeqOrnaments -> SeqOrnaments -> Bool) -> Eq SeqOrnaments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqOrnaments -> SeqOrnaments -> Bool
$c/= :: SeqOrnaments -> SeqOrnaments -> Bool
== :: SeqOrnaments -> SeqOrnaments -> Bool
$c== :: SeqOrnaments -> SeqOrnaments -> Bool
Eq,Typeable,(forall x. SeqOrnaments -> Rep SeqOrnaments x)
-> (forall x. Rep SeqOrnaments x -> SeqOrnaments)
-> Generic SeqOrnaments
forall x. Rep SeqOrnaments x -> SeqOrnaments
forall x. SeqOrnaments -> Rep SeqOrnaments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqOrnaments x -> SeqOrnaments
$cfrom :: forall x. SeqOrnaments -> Rep SeqOrnaments x
Generic,Int -> SeqOrnaments -> ShowS
[SeqOrnaments] -> ShowS
SeqOrnaments -> String
(Int -> SeqOrnaments -> ShowS)
-> (SeqOrnaments -> String)
-> ([SeqOrnaments] -> ShowS)
-> Show SeqOrnaments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqOrnaments] -> ShowS
$cshowList :: [SeqOrnaments] -> ShowS
show :: SeqOrnaments -> String
$cshow :: SeqOrnaments -> String
showsPrec :: Int -> SeqOrnaments -> ShowS
$cshowsPrec :: Int -> SeqOrnaments -> ShowS
Show)
instance EmitXml SeqOrnaments where
    emitXml :: SeqOrnaments -> XmlRep
emitXml (SeqOrnaments ChxOrnaments
a [AccidentalMark]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([ChxOrnaments -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxOrnaments
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (AccidentalMark -> XmlRep) -> [AccidentalMark] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"accidental-mark" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (AccidentalMark -> XmlRep) -> AccidentalMark -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AccidentalMark -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [AccidentalMark]
b)
parseSeqOrnaments :: P.XParse SeqOrnaments
parseSeqOrnaments :: XParse SeqOrnaments
parseSeqOrnaments = 
      ChxOrnaments -> [AccidentalMark] -> SeqOrnaments
SeqOrnaments
        (ChxOrnaments -> [AccidentalMark] -> SeqOrnaments)
-> XParse ChxOrnaments -> XParse ([AccidentalMark] -> SeqOrnaments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxOrnaments
parseChxOrnaments
        XParse ([AccidentalMark] -> SeqOrnaments)
-> XParse [AccidentalMark] -> XParse SeqOrnaments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse AccidentalMark -> XParse [AccidentalMark]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse AccidentalMark -> XParse AccidentalMark
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"accidental-mark") (XParse AccidentalMark
parseAccidentalMark))

-- | Smart constructor for 'SeqOrnaments'
mkSeqOrnaments :: ChxOrnaments -> SeqOrnaments
mkSeqOrnaments :: ChxOrnaments -> SeqOrnaments
mkSeqOrnaments ChxOrnaments
a = ChxOrnaments -> [AccidentalMark] -> SeqOrnaments
SeqOrnaments ChxOrnaments
a []

-- | @page-layout@ /(sequence)/
data SeqPageLayout = 
      SeqPageLayout {
          SeqPageLayout -> Tenths
pageLayoutPageHeight :: Tenths -- ^ /page-height/ child element
        , SeqPageLayout -> Tenths
pageLayoutPageWidth :: Tenths -- ^ /page-width/ child element
       }
    deriving (SeqPageLayout -> SeqPageLayout -> Bool
(SeqPageLayout -> SeqPageLayout -> Bool)
-> (SeqPageLayout -> SeqPageLayout -> Bool) -> Eq SeqPageLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqPageLayout -> SeqPageLayout -> Bool
$c/= :: SeqPageLayout -> SeqPageLayout -> Bool
== :: SeqPageLayout -> SeqPageLayout -> Bool
$c== :: SeqPageLayout -> SeqPageLayout -> Bool
Eq,Typeable,(forall x. SeqPageLayout -> Rep SeqPageLayout x)
-> (forall x. Rep SeqPageLayout x -> SeqPageLayout)
-> Generic SeqPageLayout
forall x. Rep SeqPageLayout x -> SeqPageLayout
forall x. SeqPageLayout -> Rep SeqPageLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqPageLayout x -> SeqPageLayout
$cfrom :: forall x. SeqPageLayout -> Rep SeqPageLayout x
Generic,Int -> SeqPageLayout -> ShowS
[SeqPageLayout] -> ShowS
SeqPageLayout -> String
(Int -> SeqPageLayout -> ShowS)
-> (SeqPageLayout -> String)
-> ([SeqPageLayout] -> ShowS)
-> Show SeqPageLayout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqPageLayout] -> ShowS
$cshowList :: [SeqPageLayout] -> ShowS
show :: SeqPageLayout -> String
$cshow :: SeqPageLayout -> String
showsPrec :: Int -> SeqPageLayout -> ShowS
$cshowsPrec :: Int -> SeqPageLayout -> ShowS
Show)
instance EmitXml SeqPageLayout where
    emitXml :: SeqPageLayout -> XmlRep
emitXml (SeqPageLayout Tenths
a Tenths
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"page-height" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"page-width" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
b)])
parseSeqPageLayout :: P.XParse SeqPageLayout
parseSeqPageLayout :: XParse SeqPageLayout
parseSeqPageLayout = 
      Tenths -> Tenths -> SeqPageLayout
SeqPageLayout
        (Tenths -> Tenths -> SeqPageLayout)
-> XParse Tenths -> XParse (Tenths -> SeqPageLayout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"page-height") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))
        XParse (Tenths -> SeqPageLayout)
-> XParse Tenths -> XParse SeqPageLayout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"page-width") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'SeqPageLayout'
mkSeqPageLayout :: Tenths -> Tenths -> SeqPageLayout
mkSeqPageLayout :: Tenths -> Tenths -> SeqPageLayout
mkSeqPageLayout Tenths
a Tenths
b = Tenths -> Tenths -> SeqPageLayout
SeqPageLayout Tenths
a Tenths
b

-- | @score-part@ /(sequence)/
data SeqScorePart = 
      SeqScorePart {
          SeqScorePart -> Maybe MidiDevice
scorePartMidiDevice :: (Maybe MidiDevice) -- ^ /midi-device/ child element
        , SeqScorePart -> Maybe MidiInstrument
scorePartMidiInstrument :: (Maybe MidiInstrument) -- ^ /midi-instrument/ child element
       }
    deriving (SeqScorePart -> SeqScorePart -> Bool
(SeqScorePart -> SeqScorePart -> Bool)
-> (SeqScorePart -> SeqScorePart -> Bool) -> Eq SeqScorePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqScorePart -> SeqScorePart -> Bool
$c/= :: SeqScorePart -> SeqScorePart -> Bool
== :: SeqScorePart -> SeqScorePart -> Bool
$c== :: SeqScorePart -> SeqScorePart -> Bool
Eq,Typeable,(forall x. SeqScorePart -> Rep SeqScorePart x)
-> (forall x. Rep SeqScorePart x -> SeqScorePart)
-> Generic SeqScorePart
forall x. Rep SeqScorePart x -> SeqScorePart
forall x. SeqScorePart -> Rep SeqScorePart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqScorePart x -> SeqScorePart
$cfrom :: forall x. SeqScorePart -> Rep SeqScorePart x
Generic,Int -> SeqScorePart -> ShowS
[SeqScorePart] -> ShowS
SeqScorePart -> String
(Int -> SeqScorePart -> ShowS)
-> (SeqScorePart -> String)
-> ([SeqScorePart] -> ShowS)
-> Show SeqScorePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqScorePart] -> ShowS
$cshowList :: [SeqScorePart] -> ShowS
show :: SeqScorePart -> String
$cshow :: SeqScorePart -> String
showsPrec :: Int -> SeqScorePart -> ShowS
$cshowsPrec :: Int -> SeqScorePart -> ShowS
Show)
instance EmitXml SeqScorePart where
    emitXml :: SeqScorePart -> XmlRep
emitXml (SeqScorePart Maybe MidiDevice
a Maybe MidiInstrument
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (MidiDevice -> XmlRep) -> Maybe MidiDevice -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-device" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MidiDevice -> XmlRep) -> MidiDevice -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MidiDevice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MidiDevice
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MidiInstrument -> XmlRep) -> Maybe MidiInstrument -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-instrument" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MidiInstrument -> XmlRep) -> MidiInstrument -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MidiInstrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MidiInstrument
b])
parseSeqScorePart :: P.XParse SeqScorePart
parseSeqScorePart :: XParse SeqScorePart
parseSeqScorePart = 
      Maybe MidiDevice -> Maybe MidiInstrument -> SeqScorePart
SeqScorePart
        (Maybe MidiDevice -> Maybe MidiInstrument -> SeqScorePart)
-> XParse (Maybe MidiDevice)
-> XParse (Maybe MidiInstrument -> SeqScorePart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse MidiDevice -> XParse (Maybe MidiDevice)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MidiDevice -> XParse MidiDevice
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-device") (XParse MidiDevice
parseMidiDevice))
        XParse (Maybe MidiInstrument -> SeqScorePart)
-> XParse (Maybe MidiInstrument) -> XParse SeqScorePart
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MidiInstrument -> XParse (Maybe MidiInstrument)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MidiInstrument -> XParse MidiInstrument
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-instrument") (XParse MidiInstrument
parseMidiInstrument))

-- | Smart constructor for 'SeqScorePart'
mkSeqScorePart :: SeqScorePart
mkSeqScorePart :: SeqScorePart
mkSeqScorePart = Maybe MidiDevice -> Maybe MidiInstrument -> SeqScorePart
SeqScorePart Maybe MidiDevice
forall a. Maybe a
Nothing Maybe MidiInstrument
forall a. Maybe a
Nothing

-- | @slash@ /(sequence)/
data SeqSlash = 
      SeqSlash {
          SeqSlash -> NoteTypeValue
slashSlashType :: NoteTypeValue -- ^ /slash-type/ child element
        , SeqSlash -> [Empty]
slashSlashDot :: [Empty] -- ^ /slash-dot/ child element
       }
    deriving (SeqSlash -> SeqSlash -> Bool
(SeqSlash -> SeqSlash -> Bool)
-> (SeqSlash -> SeqSlash -> Bool) -> Eq SeqSlash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqSlash -> SeqSlash -> Bool
$c/= :: SeqSlash -> SeqSlash -> Bool
== :: SeqSlash -> SeqSlash -> Bool
$c== :: SeqSlash -> SeqSlash -> Bool
Eq,Typeable,(forall x. SeqSlash -> Rep SeqSlash x)
-> (forall x. Rep SeqSlash x -> SeqSlash) -> Generic SeqSlash
forall x. Rep SeqSlash x -> SeqSlash
forall x. SeqSlash -> Rep SeqSlash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqSlash x -> SeqSlash
$cfrom :: forall x. SeqSlash -> Rep SeqSlash x
Generic,Int -> SeqSlash -> ShowS
[SeqSlash] -> ShowS
SeqSlash -> String
(Int -> SeqSlash -> ShowS)
-> (SeqSlash -> String) -> ([SeqSlash] -> ShowS) -> Show SeqSlash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqSlash] -> ShowS
$cshowList :: [SeqSlash] -> ShowS
show :: SeqSlash -> String
$cshow :: SeqSlash -> String
showsPrec :: Int -> SeqSlash -> ShowS
$cshowsPrec :: Int -> SeqSlash -> ShowS
Show)
instance EmitXml SeqSlash where
    emitXml :: SeqSlash -> XmlRep
emitXml (SeqSlash NoteTypeValue
a [Empty]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"slash-type" Maybe String
forall a. Maybe a
Nothing) (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Empty -> XmlRep) -> [Empty] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"slash-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Empty]
b)
parseSeqSlash :: P.XParse SeqSlash
parseSeqSlash :: XParse SeqSlash
parseSeqSlash = 
      NoteTypeValue -> [Empty] -> SeqSlash
SeqSlash
        (NoteTypeValue -> [Empty] -> SeqSlash)
-> XParse NoteTypeValue -> XParse ([Empty] -> SeqSlash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NoteTypeValue -> XParse NoteTypeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"slash-type") (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue))
        XParse ([Empty] -> SeqSlash) -> XParse [Empty] -> XParse SeqSlash
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse [Empty]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"slash-dot") (XParse Empty
parseEmpty))

-- | Smart constructor for 'SeqSlash'
mkSeqSlash :: NoteTypeValue -> SeqSlash
mkSeqSlash :: NoteTypeValue -> SeqSlash
mkSeqSlash NoteTypeValue
a = NoteTypeValue -> [Empty] -> SeqSlash
SeqSlash NoteTypeValue
a []

-- | @sound@ /(sequence)/
data SeqSound = 
      SeqSound {
          SeqSound -> Maybe MidiDevice
soundMidiDevice :: (Maybe MidiDevice) -- ^ /midi-device/ child element
        , SeqSound -> Maybe MidiInstrument
soundMidiInstrument :: (Maybe MidiInstrument) -- ^ /midi-instrument/ child element
        , SeqSound -> Maybe Play
soundPlay :: (Maybe Play) -- ^ /play/ child element
       }
    deriving (SeqSound -> SeqSound -> Bool
(SeqSound -> SeqSound -> Bool)
-> (SeqSound -> SeqSound -> Bool) -> Eq SeqSound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqSound -> SeqSound -> Bool
$c/= :: SeqSound -> SeqSound -> Bool
== :: SeqSound -> SeqSound -> Bool
$c== :: SeqSound -> SeqSound -> Bool
Eq,Typeable,(forall x. SeqSound -> Rep SeqSound x)
-> (forall x. Rep SeqSound x -> SeqSound) -> Generic SeqSound
forall x. Rep SeqSound x -> SeqSound
forall x. SeqSound -> Rep SeqSound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqSound x -> SeqSound
$cfrom :: forall x. SeqSound -> Rep SeqSound x
Generic,Int -> SeqSound -> ShowS
[SeqSound] -> ShowS
SeqSound -> String
(Int -> SeqSound -> ShowS)
-> (SeqSound -> String) -> ([SeqSound] -> ShowS) -> Show SeqSound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqSound] -> ShowS
$cshowList :: [SeqSound] -> ShowS
show :: SeqSound -> String
$cshow :: SeqSound -> String
showsPrec :: Int -> SeqSound -> ShowS
$cshowsPrec :: Int -> SeqSound -> ShowS
Show)
instance EmitXml SeqSound where
    emitXml :: SeqSound -> XmlRep
emitXml (SeqSound Maybe MidiDevice
a Maybe MidiInstrument
b Maybe Play
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (MidiDevice -> XmlRep) -> Maybe MidiDevice -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-device" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MidiDevice -> XmlRep) -> MidiDevice -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MidiDevice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MidiDevice
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (MidiInstrument -> XmlRep) -> Maybe MidiInstrument -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"midi-instrument" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (MidiInstrument -> XmlRep) -> MidiInstrument -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MidiInstrument -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe MidiInstrument
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Play -> XmlRep) -> Maybe Play -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"play" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Play -> XmlRep) -> Play -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Play -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Play
c])
parseSeqSound :: P.XParse SeqSound
parseSeqSound :: XParse SeqSound
parseSeqSound = 
      Maybe MidiDevice -> Maybe MidiInstrument -> Maybe Play -> SeqSound
SeqSound
        (Maybe MidiDevice
 -> Maybe MidiInstrument -> Maybe Play -> SeqSound)
-> XParse (Maybe MidiDevice)
-> XParse (Maybe MidiInstrument -> Maybe Play -> SeqSound)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse MidiDevice -> XParse (Maybe MidiDevice)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MidiDevice -> XParse MidiDevice
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-device") (XParse MidiDevice
parseMidiDevice))
        XParse (Maybe MidiInstrument -> Maybe Play -> SeqSound)
-> XParse (Maybe MidiInstrument) -> XParse (Maybe Play -> SeqSound)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse MidiInstrument -> XParse (Maybe MidiInstrument)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse MidiInstrument -> XParse MidiInstrument
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"midi-instrument") (XParse MidiInstrument
parseMidiInstrument))
        XParse (Maybe Play -> SeqSound)
-> XParse (Maybe Play) -> XParse SeqSound
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Play -> XParse (Maybe Play)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Play -> XParse Play
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"play") (XParse Play
parsePlay))

-- | Smart constructor for 'SeqSound'
mkSeqSound :: SeqSound
mkSeqSound :: SeqSound
mkSeqSound = Maybe MidiDevice -> Maybe MidiInstrument -> Maybe Play -> SeqSound
SeqSound Maybe MidiDevice
forall a. Maybe a
Nothing Maybe MidiInstrument
forall a. Maybe a
Nothing Maybe Play
forall a. Maybe a
Nothing

-- | @time-modification@ /(sequence)/
data SeqTimeModification = 
      SeqTimeModification {
          SeqTimeModification -> NoteTypeValue
timeModificationNormalType :: NoteTypeValue -- ^ /normal-type/ child element
        , SeqTimeModification -> [Empty]
timeModificationNormalDot :: [Empty] -- ^ /normal-dot/ child element
       }
    deriving (SeqTimeModification -> SeqTimeModification -> Bool
(SeqTimeModification -> SeqTimeModification -> Bool)
-> (SeqTimeModification -> SeqTimeModification -> Bool)
-> Eq SeqTimeModification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqTimeModification -> SeqTimeModification -> Bool
$c/= :: SeqTimeModification -> SeqTimeModification -> Bool
== :: SeqTimeModification -> SeqTimeModification -> Bool
$c== :: SeqTimeModification -> SeqTimeModification -> Bool
Eq,Typeable,(forall x. SeqTimeModification -> Rep SeqTimeModification x)
-> (forall x. Rep SeqTimeModification x -> SeqTimeModification)
-> Generic SeqTimeModification
forall x. Rep SeqTimeModification x -> SeqTimeModification
forall x. SeqTimeModification -> Rep SeqTimeModification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeqTimeModification x -> SeqTimeModification
$cfrom :: forall x. SeqTimeModification -> Rep SeqTimeModification x
Generic,Int -> SeqTimeModification -> ShowS
[SeqTimeModification] -> ShowS
SeqTimeModification -> String
(Int -> SeqTimeModification -> ShowS)
-> (SeqTimeModification -> String)
-> ([SeqTimeModification] -> ShowS)
-> Show SeqTimeModification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqTimeModification] -> ShowS
$cshowList :: [SeqTimeModification] -> ShowS
show :: SeqTimeModification -> String
$cshow :: SeqTimeModification -> String
showsPrec :: Int -> SeqTimeModification -> ShowS
$cshowsPrec :: Int -> SeqTimeModification -> ShowS
Show)
instance EmitXml SeqTimeModification where
    emitXml :: SeqTimeModification -> XmlRep
emitXml (SeqTimeModification NoteTypeValue
a [Empty]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"normal-type" Maybe String
forall a. Maybe a
Nothing) (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Empty -> XmlRep) -> [Empty] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"normal-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Empty]
b)
parseSeqTimeModification :: P.XParse SeqTimeModification
parseSeqTimeModification :: XParse SeqTimeModification
parseSeqTimeModification = 
      NoteTypeValue -> [Empty] -> SeqTimeModification
SeqTimeModification
        (NoteTypeValue -> [Empty] -> SeqTimeModification)
-> XParse NoteTypeValue -> XParse ([Empty] -> SeqTimeModification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NoteTypeValue -> XParse NoteTypeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"normal-type") (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue))
        XParse ([Empty] -> SeqTimeModification)
-> XParse [Empty] -> XParse SeqTimeModification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse [Empty]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"normal-dot") (XParse Empty
parseEmpty))

-- | Smart constructor for 'SeqTimeModification'
mkSeqTimeModification :: NoteTypeValue -> SeqTimeModification
mkSeqTimeModification :: NoteTypeValue -> SeqTimeModification
mkSeqTimeModification NoteTypeValue
a = NoteTypeValue -> [Empty] -> SeqTimeModification
SeqTimeModification NoteTypeValue
a []

-- | @all-margins@ /(group)/
data AllMargins = 
      AllMargins {
          AllMargins -> LeftRightMargins
allMarginsLeftRightMargins :: LeftRightMargins
        , AllMargins -> Tenths
allMarginsTopMargin :: Tenths -- ^ /top-margin/ child element
        , AllMargins -> Tenths
allMarginsBottomMargin :: Tenths -- ^ /bottom-margin/ child element
       }
    deriving (AllMargins -> AllMargins -> Bool
(AllMargins -> AllMargins -> Bool)
-> (AllMargins -> AllMargins -> Bool) -> Eq AllMargins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllMargins -> AllMargins -> Bool
$c/= :: AllMargins -> AllMargins -> Bool
== :: AllMargins -> AllMargins -> Bool
$c== :: AllMargins -> AllMargins -> Bool
Eq,Typeable,(forall x. AllMargins -> Rep AllMargins x)
-> (forall x. Rep AllMargins x -> AllMargins) -> Generic AllMargins
forall x. Rep AllMargins x -> AllMargins
forall x. AllMargins -> Rep AllMargins x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllMargins x -> AllMargins
$cfrom :: forall x. AllMargins -> Rep AllMargins x
Generic,Int -> AllMargins -> ShowS
[AllMargins] -> ShowS
AllMargins -> String
(Int -> AllMargins -> ShowS)
-> (AllMargins -> String)
-> ([AllMargins] -> ShowS)
-> Show AllMargins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllMargins] -> ShowS
$cshowList :: [AllMargins] -> ShowS
show :: AllMargins -> String
$cshow :: AllMargins -> String
showsPrec :: Int -> AllMargins -> ShowS
$cshowsPrec :: Int -> AllMargins -> ShowS
Show)
instance EmitXml AllMargins where
    emitXml :: AllMargins -> XmlRep
emitXml (AllMargins LeftRightMargins
a Tenths
b Tenths
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([LeftRightMargins -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml LeftRightMargins
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"top-margin" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bottom-margin" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
c)])
parseAllMargins :: P.XParse AllMargins
parseAllMargins :: XParse AllMargins
parseAllMargins = 
      LeftRightMargins -> Tenths -> Tenths -> AllMargins
AllMargins
        (LeftRightMargins -> Tenths -> Tenths -> AllMargins)
-> XParse LeftRightMargins
-> XParse (Tenths -> Tenths -> AllMargins)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse LeftRightMargins
parseLeftRightMargins
        XParse (Tenths -> Tenths -> AllMargins)
-> XParse Tenths -> XParse (Tenths -> AllMargins)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"top-margin") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))
        XParse (Tenths -> AllMargins) -> XParse Tenths -> XParse AllMargins
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bottom-margin") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'AllMargins'
mkAllMargins :: LeftRightMargins -> Tenths -> Tenths -> AllMargins
mkAllMargins :: LeftRightMargins -> Tenths -> Tenths -> AllMargins
mkAllMargins LeftRightMargins
a Tenths
b Tenths
c = LeftRightMargins -> Tenths -> Tenths -> AllMargins
AllMargins LeftRightMargins
a Tenths
b Tenths
c

-- | @beat-unit@ /(group)/
data BeatUnit = 
      BeatUnit {
          BeatUnit -> NoteTypeValue
beatUnitBeatUnit :: NoteTypeValue -- ^ /beat-unit/ child element
        , BeatUnit -> [Empty]
beatUnitBeatUnitDot :: [Empty] -- ^ /beat-unit-dot/ child element
       }
    deriving (BeatUnit -> BeatUnit -> Bool
(BeatUnit -> BeatUnit -> Bool)
-> (BeatUnit -> BeatUnit -> Bool) -> Eq BeatUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeatUnit -> BeatUnit -> Bool
$c/= :: BeatUnit -> BeatUnit -> Bool
== :: BeatUnit -> BeatUnit -> Bool
$c== :: BeatUnit -> BeatUnit -> Bool
Eq,Typeable,(forall x. BeatUnit -> Rep BeatUnit x)
-> (forall x. Rep BeatUnit x -> BeatUnit) -> Generic BeatUnit
forall x. Rep BeatUnit x -> BeatUnit
forall x. BeatUnit -> Rep BeatUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BeatUnit x -> BeatUnit
$cfrom :: forall x. BeatUnit -> Rep BeatUnit x
Generic,Int -> BeatUnit -> ShowS
[BeatUnit] -> ShowS
BeatUnit -> String
(Int -> BeatUnit -> ShowS)
-> (BeatUnit -> String) -> ([BeatUnit] -> ShowS) -> Show BeatUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeatUnit] -> ShowS
$cshowList :: [BeatUnit] -> ShowS
show :: BeatUnit -> String
$cshow :: BeatUnit -> String
showsPrec :: Int -> BeatUnit -> ShowS
$cshowsPrec :: Int -> BeatUnit -> ShowS
Show)
instance EmitXml BeatUnit where
    emitXml :: BeatUnit -> XmlRep
emitXml (BeatUnit NoteTypeValue
a [Empty]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-unit" Maybe String
forall a. Maybe a
Nothing) (NoteTypeValue -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml NoteTypeValue
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Empty -> XmlRep) -> [Empty] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-unit-dot" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Empty]
b)
parseBeatUnit :: P.XParse BeatUnit
parseBeatUnit :: XParse BeatUnit
parseBeatUnit = 
      NoteTypeValue -> [Empty] -> BeatUnit
BeatUnit
        (NoteTypeValue -> [Empty] -> BeatUnit)
-> XParse NoteTypeValue -> XParse ([Empty] -> BeatUnit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse NoteTypeValue -> XParse NoteTypeValue
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-unit") (XParse String
P.xtext XParse String
-> (String -> XParse NoteTypeValue) -> XParse NoteTypeValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse NoteTypeValue
parseNoteTypeValue))
        XParse ([Empty] -> BeatUnit) -> XParse [Empty] -> XParse BeatUnit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Empty -> XParse [Empty]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-unit-dot") (XParse Empty
parseEmpty))

-- | Smart constructor for 'BeatUnit'
mkBeatUnit :: NoteTypeValue -> BeatUnit
mkBeatUnit :: NoteTypeValue -> BeatUnit
mkBeatUnit NoteTypeValue
a = NoteTypeValue -> [Empty] -> BeatUnit
BeatUnit NoteTypeValue
a []

-- | @display-step-octave@ /(group)/
data DisplayStepOctave = 
      DisplayStepOctave {
          DisplayStepOctave -> Step
displayStepOctaveDisplayStep :: Step -- ^ /display-step/ child element
        , DisplayStepOctave -> Octave
displayStepOctaveDisplayOctave :: Octave -- ^ /display-octave/ child element
       }
    deriving (DisplayStepOctave -> DisplayStepOctave -> Bool
(DisplayStepOctave -> DisplayStepOctave -> Bool)
-> (DisplayStepOctave -> DisplayStepOctave -> Bool)
-> Eq DisplayStepOctave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayStepOctave -> DisplayStepOctave -> Bool
$c/= :: DisplayStepOctave -> DisplayStepOctave -> Bool
== :: DisplayStepOctave -> DisplayStepOctave -> Bool
$c== :: DisplayStepOctave -> DisplayStepOctave -> Bool
Eq,Typeable,(forall x. DisplayStepOctave -> Rep DisplayStepOctave x)
-> (forall x. Rep DisplayStepOctave x -> DisplayStepOctave)
-> Generic DisplayStepOctave
forall x. Rep DisplayStepOctave x -> DisplayStepOctave
forall x. DisplayStepOctave -> Rep DisplayStepOctave x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisplayStepOctave x -> DisplayStepOctave
$cfrom :: forall x. DisplayStepOctave -> Rep DisplayStepOctave x
Generic,Int -> DisplayStepOctave -> ShowS
[DisplayStepOctave] -> ShowS
DisplayStepOctave -> String
(Int -> DisplayStepOctave -> ShowS)
-> (DisplayStepOctave -> String)
-> ([DisplayStepOctave] -> ShowS)
-> Show DisplayStepOctave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayStepOctave] -> ShowS
$cshowList :: [DisplayStepOctave] -> ShowS
show :: DisplayStepOctave -> String
$cshow :: DisplayStepOctave -> String
showsPrec :: Int -> DisplayStepOctave -> ShowS
$cshowsPrec :: Int -> DisplayStepOctave -> ShowS
Show)
instance EmitXml DisplayStepOctave where
    emitXml :: DisplayStepOctave -> XmlRep
emitXml (DisplayStepOctave Step
a Octave
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"display-step" Maybe String
forall a. Maybe a
Nothing) (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"display-octave" Maybe String
forall a. Maybe a
Nothing) (Octave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Octave
b)])
parseDisplayStepOctave :: P.XParse DisplayStepOctave
parseDisplayStepOctave :: XParse DisplayStepOctave
parseDisplayStepOctave = 
      Step -> Octave -> DisplayStepOctave
DisplayStepOctave
        (Step -> Octave -> DisplayStepOctave)
-> XParse Step -> XParse (Octave -> DisplayStepOctave)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Step -> XParse Step
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"display-step") (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep))
        XParse (Octave -> DisplayStepOctave)
-> XParse Octave -> XParse DisplayStepOctave
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Octave -> XParse Octave
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"display-octave") (XParse String
P.xtext XParse String -> (String -> XParse Octave) -> XParse Octave
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Octave
parseOctave))

-- | Smart constructor for 'DisplayStepOctave'
mkDisplayStepOctave :: Step -> Octave -> DisplayStepOctave
mkDisplayStepOctave :: Step -> Octave -> DisplayStepOctave
mkDisplayStepOctave Step
a Octave
b = Step -> Octave -> DisplayStepOctave
DisplayStepOctave Step
a Octave
b

-- | @duration@ /(group)/
data Duration = 
      Duration {
          Duration -> PositiveDivisions
durationDuration :: PositiveDivisions -- ^ /duration/ child element
       }
    deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c== :: Duration -> Duration -> Bool
Eq,Typeable,(forall x. Duration -> Rep Duration x)
-> (forall x. Rep Duration x -> Duration) -> Generic Duration
forall x. Rep Duration x -> Duration
forall x. Duration -> Rep Duration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Duration x -> Duration
$cfrom :: forall x. Duration -> Rep Duration x
Generic,Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duration] -> ShowS
$cshowList :: [Duration] -> ShowS
show :: Duration -> String
$cshow :: Duration -> String
showsPrec :: Int -> Duration -> ShowS
$cshowsPrec :: Int -> Duration -> ShowS
Show)
instance EmitXml Duration where
    emitXml :: Duration -> XmlRep
emitXml (Duration PositiveDivisions
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"duration" Maybe String
forall a. Maybe a
Nothing) (PositiveDivisions -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveDivisions
a)])
parseDuration :: P.XParse Duration
parseDuration :: XParse Duration
parseDuration = 
      PositiveDivisions -> Duration
Duration
        (PositiveDivisions -> Duration)
-> XParse PositiveDivisions -> XParse Duration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PositiveDivisions -> XParse PositiveDivisions
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"duration") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveDivisions) -> XParse PositiveDivisions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveDivisions
parsePositiveDivisions))

-- | Smart constructor for 'Duration'
mkDuration :: PositiveDivisions -> Duration
mkDuration :: PositiveDivisions -> Duration
mkDuration PositiveDivisions
a = PositiveDivisions -> Duration
Duration PositiveDivisions
a

-- | @editorial@ /(group)/
data Editorial = 
      Editorial {
          Editorial -> Maybe Footnote
editorialFootnote :: (Maybe Footnote)
        , Editorial -> Maybe GrpLevel
editorialLevel :: (Maybe GrpLevel)
       }
    deriving (Editorial -> Editorial -> Bool
(Editorial -> Editorial -> Bool)
-> (Editorial -> Editorial -> Bool) -> Eq Editorial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Editorial -> Editorial -> Bool
$c/= :: Editorial -> Editorial -> Bool
== :: Editorial -> Editorial -> Bool
$c== :: Editorial -> Editorial -> Bool
Eq,Typeable,(forall x. Editorial -> Rep Editorial x)
-> (forall x. Rep Editorial x -> Editorial) -> Generic Editorial
forall x. Rep Editorial x -> Editorial
forall x. Editorial -> Rep Editorial x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Editorial x -> Editorial
$cfrom :: forall x. Editorial -> Rep Editorial x
Generic,Int -> Editorial -> ShowS
[Editorial] -> ShowS
Editorial -> String
(Int -> Editorial -> ShowS)
-> (Editorial -> String)
-> ([Editorial] -> ShowS)
-> Show Editorial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Editorial] -> ShowS
$cshowList :: [Editorial] -> ShowS
show :: Editorial -> String
$cshow :: Editorial -> String
showsPrec :: Int -> Editorial -> ShowS
$cshowsPrec :: Int -> Editorial -> ShowS
Show)
instance EmitXml Editorial where
    emitXml :: Editorial -> XmlRep
emitXml (Editorial Maybe Footnote
a Maybe GrpLevel
b) =
      [XmlRep] -> XmlRep
XReps [Maybe Footnote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Footnote
a,Maybe GrpLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe GrpLevel
b]
parseEditorial :: P.XParse Editorial
parseEditorial :: XParse Editorial
parseEditorial = 
      Maybe Footnote -> Maybe GrpLevel -> Editorial
Editorial
        (Maybe Footnote -> Maybe GrpLevel -> Editorial)
-> XParse (Maybe Footnote) -> XParse (Maybe GrpLevel -> Editorial)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Footnote -> XParse (Maybe Footnote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Footnote
parseFootnote)
        XParse (Maybe GrpLevel -> Editorial)
-> XParse (Maybe GrpLevel) -> XParse Editorial
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GrpLevel -> XParse (Maybe GrpLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse GrpLevel
parseGrpLevel)

-- | Smart constructor for 'Editorial'
mkEditorial :: Editorial
mkEditorial :: Editorial
mkEditorial = Maybe Footnote -> Maybe GrpLevel -> Editorial
Editorial Maybe Footnote
forall a. Maybe a
Nothing Maybe GrpLevel
forall a. Maybe a
Nothing

-- | @editorial-voice@ /(group)/
data EditorialVoice = 
      EditorialVoice {
          EditorialVoice -> Maybe Footnote
editorialVoiceFootnote :: (Maybe Footnote)
        , EditorialVoice -> Maybe GrpLevel
editorialVoiceLevel :: (Maybe GrpLevel)
        , EditorialVoice -> Maybe Voice
editorialVoiceVoice :: (Maybe Voice)
       }
    deriving (EditorialVoice -> EditorialVoice -> Bool
(EditorialVoice -> EditorialVoice -> Bool)
-> (EditorialVoice -> EditorialVoice -> Bool) -> Eq EditorialVoice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditorialVoice -> EditorialVoice -> Bool
$c/= :: EditorialVoice -> EditorialVoice -> Bool
== :: EditorialVoice -> EditorialVoice -> Bool
$c== :: EditorialVoice -> EditorialVoice -> Bool
Eq,Typeable,(forall x. EditorialVoice -> Rep EditorialVoice x)
-> (forall x. Rep EditorialVoice x -> EditorialVoice)
-> Generic EditorialVoice
forall x. Rep EditorialVoice x -> EditorialVoice
forall x. EditorialVoice -> Rep EditorialVoice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditorialVoice x -> EditorialVoice
$cfrom :: forall x. EditorialVoice -> Rep EditorialVoice x
Generic,Int -> EditorialVoice -> ShowS
[EditorialVoice] -> ShowS
EditorialVoice -> String
(Int -> EditorialVoice -> ShowS)
-> (EditorialVoice -> String)
-> ([EditorialVoice] -> ShowS)
-> Show EditorialVoice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditorialVoice] -> ShowS
$cshowList :: [EditorialVoice] -> ShowS
show :: EditorialVoice -> String
$cshow :: EditorialVoice -> String
showsPrec :: Int -> EditorialVoice -> ShowS
$cshowsPrec :: Int -> EditorialVoice -> ShowS
Show)
instance EmitXml EditorialVoice where
    emitXml :: EditorialVoice -> XmlRep
emitXml (EditorialVoice Maybe Footnote
a Maybe GrpLevel
b Maybe Voice
c) =
      [XmlRep] -> XmlRep
XReps [Maybe Footnote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Footnote
a,Maybe GrpLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe GrpLevel
b,Maybe Voice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Voice
c]
parseEditorialVoice :: P.XParse EditorialVoice
parseEditorialVoice :: XParse EditorialVoice
parseEditorialVoice = 
      Maybe Footnote -> Maybe GrpLevel -> Maybe Voice -> EditorialVoice
EditorialVoice
        (Maybe Footnote -> Maybe GrpLevel -> Maybe Voice -> EditorialVoice)
-> XParse (Maybe Footnote)
-> XParse (Maybe GrpLevel -> Maybe Voice -> EditorialVoice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Footnote -> XParse (Maybe Footnote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Footnote
parseFootnote)
        XParse (Maybe GrpLevel -> Maybe Voice -> EditorialVoice)
-> XParse (Maybe GrpLevel)
-> XParse (Maybe Voice -> EditorialVoice)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GrpLevel -> XParse (Maybe GrpLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse GrpLevel
parseGrpLevel)
        XParse (Maybe Voice -> EditorialVoice)
-> XParse (Maybe Voice) -> XParse EditorialVoice
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Voice -> XParse (Maybe Voice)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Voice
parseVoice)

-- | Smart constructor for 'EditorialVoice'
mkEditorialVoice :: EditorialVoice
mkEditorialVoice :: EditorialVoice
mkEditorialVoice = Maybe Footnote -> Maybe GrpLevel -> Maybe Voice -> EditorialVoice
EditorialVoice Maybe Footnote
forall a. Maybe a
Nothing Maybe GrpLevel
forall a. Maybe a
Nothing Maybe Voice
forall a. Maybe a
Nothing

-- | @editorial-voice-direction@ /(group)/
data EditorialVoiceDirection = 
      EditorialVoiceDirection {
          EditorialVoiceDirection -> Maybe Footnote
editorialVoiceDirectionFootnote :: (Maybe Footnote)
        , EditorialVoiceDirection -> Maybe GrpLevel
editorialVoiceDirectionLevel :: (Maybe GrpLevel)
        , EditorialVoiceDirection -> Maybe Voice
editorialVoiceDirectionVoice :: (Maybe Voice)
       }
    deriving (EditorialVoiceDirection -> EditorialVoiceDirection -> Bool
(EditorialVoiceDirection -> EditorialVoiceDirection -> Bool)
-> (EditorialVoiceDirection -> EditorialVoiceDirection -> Bool)
-> Eq EditorialVoiceDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditorialVoiceDirection -> EditorialVoiceDirection -> Bool
$c/= :: EditorialVoiceDirection -> EditorialVoiceDirection -> Bool
== :: EditorialVoiceDirection -> EditorialVoiceDirection -> Bool
$c== :: EditorialVoiceDirection -> EditorialVoiceDirection -> Bool
Eq,Typeable,(forall x.
 EditorialVoiceDirection -> Rep EditorialVoiceDirection x)
-> (forall x.
    Rep EditorialVoiceDirection x -> EditorialVoiceDirection)
-> Generic EditorialVoiceDirection
forall x. Rep EditorialVoiceDirection x -> EditorialVoiceDirection
forall x. EditorialVoiceDirection -> Rep EditorialVoiceDirection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditorialVoiceDirection x -> EditorialVoiceDirection
$cfrom :: forall x. EditorialVoiceDirection -> Rep EditorialVoiceDirection x
Generic,Int -> EditorialVoiceDirection -> ShowS
[EditorialVoiceDirection] -> ShowS
EditorialVoiceDirection -> String
(Int -> EditorialVoiceDirection -> ShowS)
-> (EditorialVoiceDirection -> String)
-> ([EditorialVoiceDirection] -> ShowS)
-> Show EditorialVoiceDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditorialVoiceDirection] -> ShowS
$cshowList :: [EditorialVoiceDirection] -> ShowS
show :: EditorialVoiceDirection -> String
$cshow :: EditorialVoiceDirection -> String
showsPrec :: Int -> EditorialVoiceDirection -> ShowS
$cshowsPrec :: Int -> EditorialVoiceDirection -> ShowS
Show)
instance EmitXml EditorialVoiceDirection where
    emitXml :: EditorialVoiceDirection -> XmlRep
emitXml (EditorialVoiceDirection Maybe Footnote
a Maybe GrpLevel
b Maybe Voice
c) =
      [XmlRep] -> XmlRep
XReps [Maybe Footnote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Footnote
a,Maybe GrpLevel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe GrpLevel
b,Maybe Voice -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe Voice
c]
parseEditorialVoiceDirection :: P.XParse EditorialVoiceDirection
parseEditorialVoiceDirection :: XParse EditorialVoiceDirection
parseEditorialVoiceDirection = 
      Maybe Footnote
-> Maybe GrpLevel -> Maybe Voice -> EditorialVoiceDirection
EditorialVoiceDirection
        (Maybe Footnote
 -> Maybe GrpLevel -> Maybe Voice -> EditorialVoiceDirection)
-> XParse (Maybe Footnote)
-> XParse
     (Maybe GrpLevel -> Maybe Voice -> EditorialVoiceDirection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Footnote -> XParse (Maybe Footnote)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Footnote
parseFootnote)
        XParse (Maybe GrpLevel -> Maybe Voice -> EditorialVoiceDirection)
-> XParse (Maybe GrpLevel)
-> XParse (Maybe Voice -> EditorialVoiceDirection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse GrpLevel -> XParse (Maybe GrpLevel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse GrpLevel
parseGrpLevel)
        XParse (Maybe Voice -> EditorialVoiceDirection)
-> XParse (Maybe Voice) -> XParse EditorialVoiceDirection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Voice -> XParse (Maybe Voice)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse Voice
parseVoice)

-- | Smart constructor for 'EditorialVoiceDirection'
mkEditorialVoiceDirection :: EditorialVoiceDirection
mkEditorialVoiceDirection :: EditorialVoiceDirection
mkEditorialVoiceDirection = Maybe Footnote
-> Maybe GrpLevel -> Maybe Voice -> EditorialVoiceDirection
EditorialVoiceDirection Maybe Footnote
forall a. Maybe a
Nothing Maybe GrpLevel
forall a. Maybe a
Nothing Maybe Voice
forall a. Maybe a
Nothing

-- | @footnote@ /(group)/
data Footnote = 
      Footnote {
          Footnote -> FormattedText
footnoteFootnote :: FormattedText -- ^ /footnote/ child element
       }
    deriving (Footnote -> Footnote -> Bool
(Footnote -> Footnote -> Bool)
-> (Footnote -> Footnote -> Bool) -> Eq Footnote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Footnote -> Footnote -> Bool
$c/= :: Footnote -> Footnote -> Bool
== :: Footnote -> Footnote -> Bool
$c== :: Footnote -> Footnote -> Bool
Eq,Typeable,(forall x. Footnote -> Rep Footnote x)
-> (forall x. Rep Footnote x -> Footnote) -> Generic Footnote
forall x. Rep Footnote x -> Footnote
forall x. Footnote -> Rep Footnote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Footnote x -> Footnote
$cfrom :: forall x. Footnote -> Rep Footnote x
Generic,Int -> Footnote -> ShowS
[Footnote] -> ShowS
Footnote -> String
(Int -> Footnote -> ShowS)
-> (Footnote -> String) -> ([Footnote] -> ShowS) -> Show Footnote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Footnote] -> ShowS
$cshowList :: [Footnote] -> ShowS
show :: Footnote -> String
$cshow :: Footnote -> String
showsPrec :: Int -> Footnote -> ShowS
$cshowsPrec :: Int -> Footnote -> ShowS
Show)
instance EmitXml Footnote where
    emitXml :: Footnote -> XmlRep
emitXml (Footnote FormattedText
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"footnote" Maybe String
forall a. Maybe a
Nothing) (FormattedText -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FormattedText
a)])
parseFootnote :: P.XParse Footnote
parseFootnote :: XParse Footnote
parseFootnote = 
      FormattedText -> Footnote
Footnote
        (FormattedText -> Footnote)
-> XParse FormattedText -> XParse Footnote
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse FormattedText -> XParse FormattedText
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"footnote") (XParse FormattedText
parseFormattedText))

-- | Smart constructor for 'Footnote'
mkFootnote :: FormattedText -> Footnote
mkFootnote :: FormattedText -> Footnote
mkFootnote FormattedText
a = FormattedText -> Footnote
Footnote FormattedText
a

-- | @full-note@ /(group)/
data GrpFullNote = 
      GrpFullNote {
          GrpFullNote -> Maybe Empty
fullNoteChord :: (Maybe Empty) -- ^ /chord/ child element
        , GrpFullNote -> FullNote
fullNoteFullNote :: FullNote
       }
    deriving (GrpFullNote -> GrpFullNote -> Bool
(GrpFullNote -> GrpFullNote -> Bool)
-> (GrpFullNote -> GrpFullNote -> Bool) -> Eq GrpFullNote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrpFullNote -> GrpFullNote -> Bool
$c/= :: GrpFullNote -> GrpFullNote -> Bool
== :: GrpFullNote -> GrpFullNote -> Bool
$c== :: GrpFullNote -> GrpFullNote -> Bool
Eq,Typeable,(forall x. GrpFullNote -> Rep GrpFullNote x)
-> (forall x. Rep GrpFullNote x -> GrpFullNote)
-> Generic GrpFullNote
forall x. Rep GrpFullNote x -> GrpFullNote
forall x. GrpFullNote -> Rep GrpFullNote x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrpFullNote x -> GrpFullNote
$cfrom :: forall x. GrpFullNote -> Rep GrpFullNote x
Generic,Int -> GrpFullNote -> ShowS
[GrpFullNote] -> ShowS
GrpFullNote -> String
(Int -> GrpFullNote -> ShowS)
-> (GrpFullNote -> String)
-> ([GrpFullNote] -> ShowS)
-> Show GrpFullNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrpFullNote] -> ShowS
$cshowList :: [GrpFullNote] -> ShowS
show :: GrpFullNote -> String
$cshow :: GrpFullNote -> String
showsPrec :: Int -> GrpFullNote -> ShowS
$cshowsPrec :: Int -> GrpFullNote -> ShowS
Show)
instance EmitXml GrpFullNote where
    emitXml :: GrpFullNote -> XmlRep
emitXml (GrpFullNote Maybe Empty
a FullNote
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Empty -> XmlRep) -> Maybe Empty -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"chord" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Empty -> XmlRep) -> Empty -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Empty -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Empty
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [FullNote -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml FullNote
b])
parseGrpFullNote :: P.XParse GrpFullNote
parseGrpFullNote :: XParse GrpFullNote
parseGrpFullNote = 
      Maybe Empty -> FullNote -> GrpFullNote
GrpFullNote
        (Maybe Empty -> FullNote -> GrpFullNote)
-> XParse (Maybe Empty) -> XParse (FullNote -> GrpFullNote)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Empty -> XParse (Maybe Empty)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Empty -> XParse Empty
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"chord") (XParse Empty
parseEmpty))
        XParse (FullNote -> GrpFullNote)
-> XParse FullNote -> XParse GrpFullNote
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse FullNote
parseFullNote

-- | Smart constructor for 'GrpFullNote'
mkGrpFullNote :: FullNote -> GrpFullNote
mkGrpFullNote :: FullNote -> GrpFullNote
mkGrpFullNote FullNote
b = Maybe Empty -> FullNote -> GrpFullNote
GrpFullNote Maybe Empty
forall a. Maybe a
Nothing FullNote
b

-- | @harmony-chord@ /(group)/
data HarmonyChord = 
      HarmonyChord {
          HarmonyChord -> ChxHarmonyChord
harmonyChordHarmonyChord :: ChxHarmonyChord
        , HarmonyChord -> Kind
harmonyChordKind :: Kind -- ^ /kind/ child element
        , HarmonyChord -> Maybe Inversion
harmonyChordInversion :: (Maybe Inversion) -- ^ /inversion/ child element
        , HarmonyChord -> Maybe Bass
harmonyChordBass :: (Maybe Bass) -- ^ /bass/ child element
        , HarmonyChord -> [Degree]
harmonyChordDegree :: [Degree] -- ^ /degree/ child element
       }
    deriving (HarmonyChord -> HarmonyChord -> Bool
(HarmonyChord -> HarmonyChord -> Bool)
-> (HarmonyChord -> HarmonyChord -> Bool) -> Eq HarmonyChord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HarmonyChord -> HarmonyChord -> Bool
$c/= :: HarmonyChord -> HarmonyChord -> Bool
== :: HarmonyChord -> HarmonyChord -> Bool
$c== :: HarmonyChord -> HarmonyChord -> Bool
Eq,Typeable,(forall x. HarmonyChord -> Rep HarmonyChord x)
-> (forall x. Rep HarmonyChord x -> HarmonyChord)
-> Generic HarmonyChord
forall x. Rep HarmonyChord x -> HarmonyChord
forall x. HarmonyChord -> Rep HarmonyChord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HarmonyChord x -> HarmonyChord
$cfrom :: forall x. HarmonyChord -> Rep HarmonyChord x
Generic,Int -> HarmonyChord -> ShowS
[HarmonyChord] -> ShowS
HarmonyChord -> String
(Int -> HarmonyChord -> ShowS)
-> (HarmonyChord -> String)
-> ([HarmonyChord] -> ShowS)
-> Show HarmonyChord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HarmonyChord] -> ShowS
$cshowList :: [HarmonyChord] -> ShowS
show :: HarmonyChord -> String
$cshow :: HarmonyChord -> String
showsPrec :: Int -> HarmonyChord -> ShowS
$cshowsPrec :: Int -> HarmonyChord -> ShowS
Show)
instance EmitXml HarmonyChord where
    emitXml :: HarmonyChord -> XmlRep
emitXml (HarmonyChord ChxHarmonyChord
a Kind
b Maybe Inversion
c Maybe Bass
d [Degree]
e) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([ChxHarmonyChord -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml ChxHarmonyChord
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"kind" Maybe String
forall a. Maybe a
Nothing) (Kind -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Kind
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Inversion -> XmlRep) -> Maybe Inversion -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"inversion" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Inversion -> XmlRep) -> Inversion -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Inversion -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Inversion
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Bass -> XmlRep) -> Maybe Bass -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"bass" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Bass -> XmlRep) -> Bass -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Bass -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Bass
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Degree -> XmlRep) -> [Degree] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"degree" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Degree -> XmlRep) -> Degree -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Degree -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Degree]
e)
parseHarmonyChord :: P.XParse HarmonyChord
parseHarmonyChord :: XParse HarmonyChord
parseHarmonyChord = 
      ChxHarmonyChord
-> Kind
-> Maybe Inversion
-> Maybe Bass
-> [Degree]
-> HarmonyChord
HarmonyChord
        (ChxHarmonyChord
 -> Kind
 -> Maybe Inversion
 -> Maybe Bass
 -> [Degree]
 -> HarmonyChord)
-> XParse ChxHarmonyChord
-> XParse
     (Kind -> Maybe Inversion -> Maybe Bass -> [Degree] -> HarmonyChord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxHarmonyChord
parseChxHarmonyChord
        XParse
  (Kind -> Maybe Inversion -> Maybe Bass -> [Degree] -> HarmonyChord)
-> XParse Kind
-> XParse
     (Maybe Inversion -> Maybe Bass -> [Degree] -> HarmonyChord)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Kind -> XParse Kind
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"kind") (XParse Kind
parseKind))
        XParse (Maybe Inversion -> Maybe Bass -> [Degree] -> HarmonyChord)
-> XParse (Maybe Inversion)
-> XParse (Maybe Bass -> [Degree] -> HarmonyChord)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Inversion -> XParse (Maybe Inversion)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Inversion -> XParse Inversion
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"inversion") (XParse Inversion
parseInversion))
        XParse (Maybe Bass -> [Degree] -> HarmonyChord)
-> XParse (Maybe Bass) -> XParse ([Degree] -> HarmonyChord)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Bass -> XParse (Maybe Bass)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Bass -> XParse Bass
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"bass") (XParse Bass
parseBass))
        XParse ([Degree] -> HarmonyChord)
-> XParse [Degree] -> XParse HarmonyChord
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Degree -> XParse [Degree]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Degree -> XParse Degree
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"degree") (XParse Degree
parseDegree))

-- | Smart constructor for 'HarmonyChord'
mkHarmonyChord :: ChxHarmonyChord -> Kind -> HarmonyChord
mkHarmonyChord :: ChxHarmonyChord -> Kind -> HarmonyChord
mkHarmonyChord ChxHarmonyChord
a Kind
b = ChxHarmonyChord
-> Kind
-> Maybe Inversion
-> Maybe Bass
-> [Degree]
-> HarmonyChord
HarmonyChord ChxHarmonyChord
a Kind
b Maybe Inversion
forall a. Maybe a
Nothing Maybe Bass
forall a. Maybe a
Nothing []

-- | @layout@ /(group)/
data Layout = 
      Layout {
          Layout -> Maybe PageLayout
layoutPageLayout :: (Maybe PageLayout) -- ^ /page-layout/ child element
        , Layout -> Maybe SystemLayout
layoutSystemLayout :: (Maybe SystemLayout) -- ^ /system-layout/ child element
        , Layout -> [StaffLayout]
layoutStaffLayout :: [StaffLayout] -- ^ /staff-layout/ child element
       }
    deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c== :: Layout -> Layout -> Bool
Eq,Typeable,(forall x. Layout -> Rep Layout x)
-> (forall x. Rep Layout x -> Layout) -> Generic Layout
forall x. Rep Layout x -> Layout
forall x. Layout -> Rep Layout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Layout x -> Layout
$cfrom :: forall x. Layout -> Rep Layout x
Generic,Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> String
(Int -> Layout -> ShowS)
-> (Layout -> String) -> ([Layout] -> ShowS) -> Show Layout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> String
$cshow :: Layout -> String
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show)
instance EmitXml Layout where
    emitXml :: Layout -> XmlRep
emitXml (Layout Maybe PageLayout
a Maybe SystemLayout
b [StaffLayout]
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (PageLayout -> XmlRep) -> Maybe PageLayout -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"page-layout" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (PageLayout -> XmlRep) -> PageLayout -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PageLayout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe PageLayout
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (SystemLayout -> XmlRep) -> Maybe SystemLayout -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"system-layout" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (SystemLayout -> XmlRep) -> SystemLayout -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.SystemLayout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe SystemLayout
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (StaffLayout -> XmlRep) -> [StaffLayout] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff-layout" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (StaffLayout -> XmlRep) -> StaffLayout -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.StaffLayout -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [StaffLayout]
c)
parseLayout :: P.XParse Layout
parseLayout :: XParse Layout
parseLayout = 
      Maybe PageLayout -> Maybe SystemLayout -> [StaffLayout] -> Layout
Layout
        (Maybe PageLayout -> Maybe SystemLayout -> [StaffLayout] -> Layout)
-> XParse (Maybe PageLayout)
-> XParse (Maybe SystemLayout -> [StaffLayout] -> Layout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse PageLayout -> XParse (Maybe PageLayout)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse PageLayout -> XParse PageLayout
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"page-layout") (XParse PageLayout
parsePageLayout))
        XParse (Maybe SystemLayout -> [StaffLayout] -> Layout)
-> XParse (Maybe SystemLayout) -> XParse ([StaffLayout] -> Layout)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse SystemLayout -> XParse (Maybe SystemLayout)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse SystemLayout -> XParse SystemLayout
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"system-layout") (XParse SystemLayout
parseSystemLayout))
        XParse ([StaffLayout] -> Layout)
-> XParse [StaffLayout] -> XParse Layout
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse StaffLayout -> XParse [StaffLayout]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse StaffLayout -> XParse StaffLayout
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff-layout") (XParse StaffLayout
parseStaffLayout))

-- | Smart constructor for 'Layout'
mkLayout :: Layout
mkLayout :: Layout
mkLayout = Maybe PageLayout -> Maybe SystemLayout -> [StaffLayout] -> Layout
Layout Maybe PageLayout
forall a. Maybe a
Nothing Maybe SystemLayout
forall a. Maybe a
Nothing []

-- | @left-right-margins@ /(group)/
data LeftRightMargins = 
      LeftRightMargins {
          LeftRightMargins -> Tenths
leftRightMarginsLeftMargin :: Tenths -- ^ /left-margin/ child element
        , LeftRightMargins -> Tenths
leftRightMarginsRightMargin :: Tenths -- ^ /right-margin/ child element
       }
    deriving (LeftRightMargins -> LeftRightMargins -> Bool
(LeftRightMargins -> LeftRightMargins -> Bool)
-> (LeftRightMargins -> LeftRightMargins -> Bool)
-> Eq LeftRightMargins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeftRightMargins -> LeftRightMargins -> Bool
$c/= :: LeftRightMargins -> LeftRightMargins -> Bool
== :: LeftRightMargins -> LeftRightMargins -> Bool
$c== :: LeftRightMargins -> LeftRightMargins -> Bool
Eq,Typeable,(forall x. LeftRightMargins -> Rep LeftRightMargins x)
-> (forall x. Rep LeftRightMargins x -> LeftRightMargins)
-> Generic LeftRightMargins
forall x. Rep LeftRightMargins x -> LeftRightMargins
forall x. LeftRightMargins -> Rep LeftRightMargins x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LeftRightMargins x -> LeftRightMargins
$cfrom :: forall x. LeftRightMargins -> Rep LeftRightMargins x
Generic,Int -> LeftRightMargins -> ShowS
[LeftRightMargins] -> ShowS
LeftRightMargins -> String
(Int -> LeftRightMargins -> ShowS)
-> (LeftRightMargins -> String)
-> ([LeftRightMargins] -> ShowS)
-> Show LeftRightMargins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeftRightMargins] -> ShowS
$cshowList :: [LeftRightMargins] -> ShowS
show :: LeftRightMargins -> String
$cshow :: LeftRightMargins -> String
showsPrec :: Int -> LeftRightMargins -> ShowS
$cshowsPrec :: Int -> LeftRightMargins -> ShowS
Show)
instance EmitXml LeftRightMargins where
    emitXml :: LeftRightMargins -> XmlRep
emitXml (LeftRightMargins Tenths
a Tenths
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"left-margin" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"right-margin" Maybe String
forall a. Maybe a
Nothing) (Tenths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Tenths
b)])
parseLeftRightMargins :: P.XParse LeftRightMargins
parseLeftRightMargins :: XParse LeftRightMargins
parseLeftRightMargins = 
      Tenths -> Tenths -> LeftRightMargins
LeftRightMargins
        (Tenths -> Tenths -> LeftRightMargins)
-> XParse Tenths -> XParse (Tenths -> LeftRightMargins)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"left-margin") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))
        XParse (Tenths -> LeftRightMargins)
-> XParse Tenths -> XParse LeftRightMargins
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Tenths -> XParse Tenths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"right-margin") (XParse String
P.xtext XParse String -> (String -> XParse Tenths) -> XParse Tenths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Tenths
parseTenths))

-- | Smart constructor for 'LeftRightMargins'
mkLeftRightMargins :: Tenths -> Tenths -> LeftRightMargins
mkLeftRightMargins :: Tenths -> Tenths -> LeftRightMargins
mkLeftRightMargins Tenths
a Tenths
b = Tenths -> Tenths -> LeftRightMargins
LeftRightMargins Tenths
a Tenths
b

-- | @level@ /(group)/
data GrpLevel = 
      GrpLevel {
          GrpLevel -> Level
levelLevel :: Level -- ^ /level/ child element
       }
    deriving (GrpLevel -> GrpLevel -> Bool
(GrpLevel -> GrpLevel -> Bool)
-> (GrpLevel -> GrpLevel -> Bool) -> Eq GrpLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrpLevel -> GrpLevel -> Bool
$c/= :: GrpLevel -> GrpLevel -> Bool
== :: GrpLevel -> GrpLevel -> Bool
$c== :: GrpLevel -> GrpLevel -> Bool
Eq,Typeable,(forall x. GrpLevel -> Rep GrpLevel x)
-> (forall x. Rep GrpLevel x -> GrpLevel) -> Generic GrpLevel
forall x. Rep GrpLevel x -> GrpLevel
forall x. GrpLevel -> Rep GrpLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrpLevel x -> GrpLevel
$cfrom :: forall x. GrpLevel -> Rep GrpLevel x
Generic,Int -> GrpLevel -> ShowS
[GrpLevel] -> ShowS
GrpLevel -> String
(Int -> GrpLevel -> ShowS)
-> (GrpLevel -> String) -> ([GrpLevel] -> ShowS) -> Show GrpLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrpLevel] -> ShowS
$cshowList :: [GrpLevel] -> ShowS
show :: GrpLevel -> String
$cshow :: GrpLevel -> String
showsPrec :: Int -> GrpLevel -> ShowS
$cshowsPrec :: Int -> GrpLevel -> ShowS
Show)
instance EmitXml GrpLevel where
    emitXml :: GrpLevel -> XmlRep
emitXml (GrpLevel Level
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"level" Maybe String
forall a. Maybe a
Nothing) (Level -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Level
a)])
parseGrpLevel :: P.XParse GrpLevel
parseGrpLevel :: XParse GrpLevel
parseGrpLevel = 
      Level -> GrpLevel
GrpLevel
        (Level -> GrpLevel) -> XParse Level -> XParse GrpLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Level -> XParse Level
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"level") (XParse Level
parseLevel))

-- | Smart constructor for 'GrpLevel'
mkGrpLevel :: Level -> GrpLevel
mkGrpLevel :: Level -> GrpLevel
mkGrpLevel Level
a = Level -> GrpLevel
GrpLevel Level
a

-- | @music-data@ /(group)/
data MusicData = 
      MusicData {
          MusicData -> [ChxMusicData]
musicDataMusicData :: [ChxMusicData]
       }
    deriving (MusicData -> MusicData -> Bool
(MusicData -> MusicData -> Bool)
-> (MusicData -> MusicData -> Bool) -> Eq MusicData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MusicData -> MusicData -> Bool
$c/= :: MusicData -> MusicData -> Bool
== :: MusicData -> MusicData -> Bool
$c== :: MusicData -> MusicData -> Bool
Eq,Typeable,(forall x. MusicData -> Rep MusicData x)
-> (forall x. Rep MusicData x -> MusicData) -> Generic MusicData
forall x. Rep MusicData x -> MusicData
forall x. MusicData -> Rep MusicData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MusicData x -> MusicData
$cfrom :: forall x. MusicData -> Rep MusicData x
Generic,Int -> MusicData -> ShowS
[MusicData] -> ShowS
MusicData -> String
(Int -> MusicData -> ShowS)
-> (MusicData -> String)
-> ([MusicData] -> ShowS)
-> Show MusicData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MusicData] -> ShowS
$cshowList :: [MusicData] -> ShowS
show :: MusicData -> String
$cshow :: MusicData -> String
showsPrec :: Int -> MusicData -> ShowS
$cshowsPrec :: Int -> MusicData -> ShowS
Show)
instance EmitXml MusicData where
    emitXml :: MusicData -> XmlRep
emitXml (MusicData [ChxMusicData]
a) =
      [XmlRep] -> XmlRep
XReps [[ChxMusicData] -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml [ChxMusicData]
a]
parseMusicData :: P.XParse MusicData
parseMusicData :: XParse MusicData
parseMusicData = 
      [ChxMusicData] -> MusicData
MusicData
        ([ChxMusicData] -> MusicData)
-> XParse [ChxMusicData] -> XParse MusicData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse ChxMusicData -> XParse [ChxMusicData]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (XParse ChxMusicData
parseChxMusicData)

-- | Smart constructor for 'MusicData'
mkMusicData :: MusicData
mkMusicData :: MusicData
mkMusicData = [ChxMusicData] -> MusicData
MusicData []

-- | @non-traditional-key@ /(group)/
data NonTraditionalKey = 
      NonTraditionalKey {
          NonTraditionalKey -> Step
nonTraditionalKeyKeyStep :: Step -- ^ /key-step/ child element
        , NonTraditionalKey -> Semitones
nonTraditionalKeyKeyAlter :: Semitones -- ^ /key-alter/ child element
        , NonTraditionalKey -> Maybe KeyAccidental
nonTraditionalKeyKeyAccidental :: (Maybe KeyAccidental) -- ^ /key-accidental/ child element
       }
    deriving (NonTraditionalKey -> NonTraditionalKey -> Bool
(NonTraditionalKey -> NonTraditionalKey -> Bool)
-> (NonTraditionalKey -> NonTraditionalKey -> Bool)
-> Eq NonTraditionalKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonTraditionalKey -> NonTraditionalKey -> Bool
$c/= :: NonTraditionalKey -> NonTraditionalKey -> Bool
== :: NonTraditionalKey -> NonTraditionalKey -> Bool
$c== :: NonTraditionalKey -> NonTraditionalKey -> Bool
Eq,Typeable,(forall x. NonTraditionalKey -> Rep NonTraditionalKey x)
-> (forall x. Rep NonTraditionalKey x -> NonTraditionalKey)
-> Generic NonTraditionalKey
forall x. Rep NonTraditionalKey x -> NonTraditionalKey
forall x. NonTraditionalKey -> Rep NonTraditionalKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NonTraditionalKey x -> NonTraditionalKey
$cfrom :: forall x. NonTraditionalKey -> Rep NonTraditionalKey x
Generic,Int -> NonTraditionalKey -> ShowS
[NonTraditionalKey] -> ShowS
NonTraditionalKey -> String
(Int -> NonTraditionalKey -> ShowS)
-> (NonTraditionalKey -> String)
-> ([NonTraditionalKey] -> ShowS)
-> Show NonTraditionalKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonTraditionalKey] -> ShowS
$cshowList :: [NonTraditionalKey] -> ShowS
show :: NonTraditionalKey -> String
$cshow :: NonTraditionalKey -> String
showsPrec :: Int -> NonTraditionalKey -> ShowS
$cshowsPrec :: Int -> NonTraditionalKey -> ShowS
Show)
instance EmitXml NonTraditionalKey where
    emitXml :: NonTraditionalKey -> XmlRep
emitXml (NonTraditionalKey Step
a Semitones
b Maybe KeyAccidental
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"key-step" Maybe String
forall a. Maybe a
Nothing) (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"key-alter" Maybe String
forall a. Maybe a
Nothing) (Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Semitones
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (KeyAccidental -> XmlRep) -> Maybe KeyAccidental -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"key-accidental" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (KeyAccidental -> XmlRep) -> KeyAccidental -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.KeyAccidental -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe KeyAccidental
c])
parseNonTraditionalKey :: P.XParse NonTraditionalKey
parseNonTraditionalKey :: XParse NonTraditionalKey
parseNonTraditionalKey = 
      Step -> Semitones -> Maybe KeyAccidental -> NonTraditionalKey
NonTraditionalKey
        (Step -> Semitones -> Maybe KeyAccidental -> NonTraditionalKey)
-> XParse Step
-> XParse (Semitones -> Maybe KeyAccidental -> NonTraditionalKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Step -> XParse Step
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"key-step") (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep))
        XParse (Semitones -> Maybe KeyAccidental -> NonTraditionalKey)
-> XParse Semitones
-> XParse (Maybe KeyAccidental -> NonTraditionalKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"key-alter") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))
        XParse (Maybe KeyAccidental -> NonTraditionalKey)
-> XParse (Maybe KeyAccidental) -> XParse NonTraditionalKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse KeyAccidental -> XParse (Maybe KeyAccidental)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse KeyAccidental -> XParse KeyAccidental
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"key-accidental") (XParse KeyAccidental
parseKeyAccidental))

-- | Smart constructor for 'NonTraditionalKey'
mkNonTraditionalKey :: Step -> Semitones -> NonTraditionalKey
mkNonTraditionalKey :: Step -> Semitones -> NonTraditionalKey
mkNonTraditionalKey Step
a Semitones
b = Step -> Semitones -> Maybe KeyAccidental -> NonTraditionalKey
NonTraditionalKey Step
a Semitones
b Maybe KeyAccidental
forall a. Maybe a
Nothing

-- | @part-group@ /(group)/
data GrpPartGroup = 
      GrpPartGroup {
          GrpPartGroup -> PartGroup
partGroupPartGroup :: PartGroup -- ^ /part-group/ child element
       }
    deriving (GrpPartGroup -> GrpPartGroup -> Bool
(GrpPartGroup -> GrpPartGroup -> Bool)
-> (GrpPartGroup -> GrpPartGroup -> Bool) -> Eq GrpPartGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GrpPartGroup -> GrpPartGroup -> Bool
$c/= :: GrpPartGroup -> GrpPartGroup -> Bool
== :: GrpPartGroup -> GrpPartGroup -> Bool
$c== :: GrpPartGroup -> GrpPartGroup -> Bool
Eq,Typeable,(forall x. GrpPartGroup -> Rep GrpPartGroup x)
-> (forall x. Rep GrpPartGroup x -> GrpPartGroup)
-> Generic GrpPartGroup
forall x. Rep GrpPartGroup x -> GrpPartGroup
forall x. GrpPartGroup -> Rep GrpPartGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GrpPartGroup x -> GrpPartGroup
$cfrom :: forall x. GrpPartGroup -> Rep GrpPartGroup x
Generic,Int -> GrpPartGroup -> ShowS
[GrpPartGroup] -> ShowS
GrpPartGroup -> String
(Int -> GrpPartGroup -> ShowS)
-> (GrpPartGroup -> String)
-> ([GrpPartGroup] -> ShowS)
-> Show GrpPartGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GrpPartGroup] -> ShowS
$cshowList :: [GrpPartGroup] -> ShowS
show :: GrpPartGroup -> String
$cshow :: GrpPartGroup -> String
showsPrec :: Int -> GrpPartGroup -> ShowS
$cshowsPrec :: Int -> GrpPartGroup -> ShowS
Show)
instance EmitXml GrpPartGroup where
    emitXml :: GrpPartGroup -> XmlRep
emitXml (GrpPartGroup PartGroup
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-group" Maybe String
forall a. Maybe a
Nothing) (PartGroup -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PartGroup
a)])
parseGrpPartGroup :: P.XParse GrpPartGroup
parseGrpPartGroup :: XParse GrpPartGroup
parseGrpPartGroup = 
      PartGroup -> GrpPartGroup
GrpPartGroup
        (PartGroup -> GrpPartGroup)
-> XParse PartGroup -> XParse GrpPartGroup
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PartGroup -> XParse PartGroup
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-group") (XParse PartGroup
parsePartGroup))

-- | Smart constructor for 'GrpPartGroup'
mkGrpPartGroup :: PartGroup -> GrpPartGroup
mkGrpPartGroup :: PartGroup -> GrpPartGroup
mkGrpPartGroup PartGroup
a = PartGroup -> GrpPartGroup
GrpPartGroup PartGroup
a

-- | @score-header@ /(group)/
data ScoreHeader = 
      ScoreHeader {
          ScoreHeader -> Maybe Work
scoreHeaderWork :: (Maybe Work) -- ^ /work/ child element
        , ScoreHeader -> Maybe String
scoreHeaderMovementNumber :: (Maybe String) -- ^ /movement-number/ child element
        , ScoreHeader -> Maybe String
scoreHeaderMovementTitle :: (Maybe String) -- ^ /movement-title/ child element
        , ScoreHeader -> Maybe Identification
scoreHeaderIdentification :: (Maybe Identification) -- ^ /identification/ child element
        , ScoreHeader -> Maybe Defaults
scoreHeaderDefaults :: (Maybe Defaults) -- ^ /defaults/ child element
        , ScoreHeader -> [Credit]
scoreHeaderCredit :: [Credit] -- ^ /credit/ child element
        , ScoreHeader -> PartList
scoreHeaderPartList :: PartList -- ^ /part-list/ child element
       }
    deriving (ScoreHeader -> ScoreHeader -> Bool
(ScoreHeader -> ScoreHeader -> Bool)
-> (ScoreHeader -> ScoreHeader -> Bool) -> Eq ScoreHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoreHeader -> ScoreHeader -> Bool
$c/= :: ScoreHeader -> ScoreHeader -> Bool
== :: ScoreHeader -> ScoreHeader -> Bool
$c== :: ScoreHeader -> ScoreHeader -> Bool
Eq,Typeable,(forall x. ScoreHeader -> Rep ScoreHeader x)
-> (forall x. Rep ScoreHeader x -> ScoreHeader)
-> Generic ScoreHeader
forall x. Rep ScoreHeader x -> ScoreHeader
forall x. ScoreHeader -> Rep ScoreHeader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScoreHeader x -> ScoreHeader
$cfrom :: forall x. ScoreHeader -> Rep ScoreHeader x
Generic,Int -> ScoreHeader -> ShowS
[ScoreHeader] -> ShowS
ScoreHeader -> String
(Int -> ScoreHeader -> ShowS)
-> (ScoreHeader -> String)
-> ([ScoreHeader] -> ShowS)
-> Show ScoreHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScoreHeader] -> ShowS
$cshowList :: [ScoreHeader] -> ShowS
show :: ScoreHeader -> String
$cshow :: ScoreHeader -> String
showsPrec :: Int -> ScoreHeader -> ShowS
$cshowsPrec :: Int -> ScoreHeader -> ShowS
Show)
instance EmitXml ScoreHeader where
    emitXml :: ScoreHeader -> XmlRep
emitXml (ScoreHeader Maybe Work
a Maybe String
b Maybe String
c Maybe Identification
d Maybe Defaults
e [Credit]
f PartList
g) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Work -> XmlRep) -> Maybe Work -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"work" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Work -> XmlRep) -> Work -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Work -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Work
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"movement-number" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (String -> XmlRep) -> Maybe String -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"movement-title" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe String
c] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep
-> (Identification -> XmlRep) -> Maybe Identification -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"identification" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep)
-> (Identification -> XmlRep) -> Identification -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Identification -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Identification
d] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Defaults -> XmlRep) -> Maybe Defaults -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"defaults" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Defaults -> XmlRep) -> Defaults -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Defaults -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Defaults
e] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (Credit -> XmlRep) -> [Credit] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"credit" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Credit -> XmlRep) -> Credit -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Credit -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [Credit]
f [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"part-list" Maybe String
forall a. Maybe a
Nothing) (PartList -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PartList
g)])
parseScoreHeader :: P.XParse ScoreHeader
parseScoreHeader :: XParse ScoreHeader
parseScoreHeader = 
      Maybe Work
-> Maybe String
-> Maybe String
-> Maybe Identification
-> Maybe Defaults
-> [Credit]
-> PartList
-> ScoreHeader
ScoreHeader
        (Maybe Work
 -> Maybe String
 -> Maybe String
 -> Maybe Identification
 -> Maybe Defaults
 -> [Credit]
 -> PartList
 -> ScoreHeader)
-> XParse (Maybe Work)
-> XParse
     (Maybe String
      -> Maybe String
      -> Maybe Identification
      -> Maybe Defaults
      -> [Credit]
      -> PartList
      -> ScoreHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Work -> XParse (Maybe Work)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Work -> XParse Work
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"work") (XParse Work
parseWork))
        XParse
  (Maybe String
   -> Maybe String
   -> Maybe Identification
   -> Maybe Defaults
   -> [Credit]
   -> PartList
   -> ScoreHeader)
-> XParse (Maybe String)
-> XParse
     (Maybe String
      -> Maybe Identification
      -> Maybe Defaults
      -> [Credit]
      -> PartList
      -> ScoreHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"movement-number") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe String
   -> Maybe Identification
   -> Maybe Defaults
   -> [Credit]
   -> PartList
   -> ScoreHeader)
-> XParse (Maybe String)
-> XParse
     (Maybe Identification
      -> Maybe Defaults -> [Credit] -> PartList -> ScoreHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"movement-title") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse
  (Maybe Identification
   -> Maybe Defaults -> [Credit] -> PartList -> ScoreHeader)
-> XParse (Maybe Identification)
-> XParse (Maybe Defaults -> [Credit] -> PartList -> ScoreHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Identification -> XParse (Maybe Identification)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Identification -> XParse Identification
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"identification") (XParse Identification
parseIdentification))
        XParse (Maybe Defaults -> [Credit] -> PartList -> ScoreHeader)
-> XParse (Maybe Defaults)
-> XParse ([Credit] -> PartList -> ScoreHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Defaults -> XParse (Maybe Defaults)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Defaults -> XParse Defaults
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"defaults") (XParse Defaults
parseDefaults))
        XParse ([Credit] -> PartList -> ScoreHeader)
-> XParse [Credit] -> XParse (PartList -> ScoreHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Credit -> XParse [Credit]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse Credit -> XParse Credit
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"credit") (XParse Credit
parseCredit))
        XParse (PartList -> ScoreHeader)
-> XParse PartList -> XParse ScoreHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse PartList -> XParse PartList
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"part-list") (XParse PartList
parsePartList))

-- | Smart constructor for 'ScoreHeader'
mkScoreHeader :: PartList -> ScoreHeader
mkScoreHeader :: PartList -> ScoreHeader
mkScoreHeader PartList
g = Maybe Work
-> Maybe String
-> Maybe String
-> Maybe Identification
-> Maybe Defaults
-> [Credit]
-> PartList
-> ScoreHeader
ScoreHeader Maybe Work
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe Identification
forall a. Maybe a
Nothing Maybe Defaults
forall a. Maybe a
Nothing [] PartList
g

-- | @score-part@ /(group)/
data ScorePart = 
      ScorePart {
          ScorePart -> CmpScorePart
grpscorePartScorePart :: CmpScorePart -- ^ /score-part/ child element
       }
    deriving (ScorePart -> ScorePart -> Bool
(ScorePart -> ScorePart -> Bool)
-> (ScorePart -> ScorePart -> Bool) -> Eq ScorePart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScorePart -> ScorePart -> Bool
$c/= :: ScorePart -> ScorePart -> Bool
== :: ScorePart -> ScorePart -> Bool
$c== :: ScorePart -> ScorePart -> Bool
Eq,Typeable,(forall x. ScorePart -> Rep ScorePart x)
-> (forall x. Rep ScorePart x -> ScorePart) -> Generic ScorePart
forall x. Rep ScorePart x -> ScorePart
forall x. ScorePart -> Rep ScorePart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScorePart x -> ScorePart
$cfrom :: forall x. ScorePart -> Rep ScorePart x
Generic,Int -> ScorePart -> ShowS
[ScorePart] -> ShowS
ScorePart -> String
(Int -> ScorePart -> ShowS)
-> (ScorePart -> String)
-> ([ScorePart] -> ShowS)
-> Show ScorePart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScorePart] -> ShowS
$cshowList :: [ScorePart] -> ShowS
show :: ScorePart -> String
$cshow :: ScorePart -> String
showsPrec :: Int -> ScorePart -> ShowS
$cshowsPrec :: Int -> ScorePart -> ShowS
Show)
instance EmitXml ScorePart where
    emitXml :: ScorePart -> XmlRep
emitXml (ScorePart CmpScorePart
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"score-part" Maybe String
forall a. Maybe a
Nothing) (CmpScorePart -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml CmpScorePart
a)])
parseScorePart :: P.XParse ScorePart
parseScorePart :: XParse ScorePart
parseScorePart = 
      CmpScorePart -> ScorePart
ScorePart
        (CmpScorePart -> ScorePart)
-> XParse CmpScorePart -> XParse ScorePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse CmpScorePart -> XParse CmpScorePart
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"score-part") (XParse CmpScorePart
parseCmpScorePart))

-- | Smart constructor for 'ScorePart'
mkScorePart :: CmpScorePart -> ScorePart
mkScorePart :: CmpScorePart -> ScorePart
mkScorePart CmpScorePart
a = CmpScorePart -> ScorePart
ScorePart CmpScorePart
a

-- | @slash@ /(group)/
data Slash = 
      Slash {
          Slash -> Maybe SeqSlash
grpslashSlash :: (Maybe SeqSlash)
        , Slash -> [String]
slashExceptVoice :: [String] -- ^ /except-voice/ child element
       }
    deriving (Slash -> Slash -> Bool
(Slash -> Slash -> Bool) -> (Slash -> Slash -> Bool) -> Eq Slash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slash -> Slash -> Bool
$c/= :: Slash -> Slash -> Bool
== :: Slash -> Slash -> Bool
$c== :: Slash -> Slash -> Bool
Eq,Typeable,(forall x. Slash -> Rep Slash x)
-> (forall x. Rep Slash x -> Slash) -> Generic Slash
forall x. Rep Slash x -> Slash
forall x. Slash -> Rep Slash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Slash x -> Slash
$cfrom :: forall x. Slash -> Rep Slash x
Generic,Int -> Slash -> ShowS
[Slash] -> ShowS
Slash -> String
(Int -> Slash -> ShowS)
-> (Slash -> String) -> ([Slash] -> ShowS) -> Show Slash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slash] -> ShowS
$cshowList :: [Slash] -> ShowS
show :: Slash -> String
$cshow :: Slash -> String
showsPrec :: Int -> Slash -> ShowS
$cshowsPrec :: Int -> Slash -> ShowS
Show)
instance EmitXml Slash where
    emitXml :: Slash -> XmlRep
emitXml (Slash Maybe SeqSlash
a [String]
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([Maybe SeqSlash -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Maybe SeqSlash
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        (String -> XmlRep) -> [String] -> [XmlRep]
forall a b. (a -> b) -> [a] -> [b]
map (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"except-voice" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (String -> XmlRep) -> String -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) [String]
b)
parseSlash :: P.XParse Slash
parseSlash :: XParse Slash
parseSlash = 
      Maybe SeqSlash -> [String] -> Slash
Slash
        (Maybe SeqSlash -> [String] -> Slash)
-> XParse (Maybe SeqSlash) -> XParse ([String] -> Slash)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse SeqSlash -> XParse (Maybe SeqSlash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (XParse SeqSlash
parseSeqSlash)
        XParse ([String] -> Slash) -> XParse [String] -> XParse Slash
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse String -> XParse [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
P.many (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"except-voice") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'Slash'
mkSlash :: Slash
mkSlash :: Slash
mkSlash = Maybe SeqSlash -> [String] -> Slash
Slash Maybe SeqSlash
forall a. Maybe a
Nothing []

-- | @staff@ /(group)/
data Staff = 
      Staff {
          Staff -> PositiveInteger
staffStaff :: PositiveInteger -- ^ /staff/ child element
       }
    deriving (Staff -> Staff -> Bool
(Staff -> Staff -> Bool) -> (Staff -> Staff -> Bool) -> Eq Staff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Staff -> Staff -> Bool
$c/= :: Staff -> Staff -> Bool
== :: Staff -> Staff -> Bool
$c== :: Staff -> Staff -> Bool
Eq,Typeable,(forall x. Staff -> Rep Staff x)
-> (forall x. Rep Staff x -> Staff) -> Generic Staff
forall x. Rep Staff x -> Staff
forall x. Staff -> Rep Staff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Staff x -> Staff
$cfrom :: forall x. Staff -> Rep Staff x
Generic,Int -> Staff -> ShowS
[Staff] -> ShowS
Staff -> String
(Int -> Staff -> ShowS)
-> (Staff -> String) -> ([Staff] -> ShowS) -> Show Staff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Staff] -> ShowS
$cshowList :: [Staff] -> ShowS
show :: Staff -> String
$cshow :: Staff -> String
showsPrec :: Int -> Staff -> ShowS
$cshowsPrec :: Int -> Staff -> ShowS
Show)
instance EmitXml Staff where
    emitXml :: Staff -> XmlRep
emitXml (Staff PositiveInteger
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"staff" Maybe String
forall a. Maybe a
Nothing) (PositiveInteger -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml PositiveInteger
a)])
parseStaff :: P.XParse Staff
parseStaff :: XParse Staff
parseStaff = 
      PositiveInteger -> Staff
Staff
        (PositiveInteger -> Staff)
-> XParse PositiveInteger -> XParse Staff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse PositiveInteger -> XParse PositiveInteger
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"staff") (XParse String
P.xtext XParse String
-> (String -> XParse PositiveInteger) -> XParse PositiveInteger
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse PositiveInteger
parsePositiveInteger))

-- | Smart constructor for 'Staff'
mkStaff :: PositiveInteger -> Staff
mkStaff :: PositiveInteger -> Staff
mkStaff PositiveInteger
a = PositiveInteger -> Staff
Staff PositiveInteger
a

-- | @time-signature@ /(group)/
data TimeSignature = 
      TimeSignature {
          TimeSignature -> String
timeSignatureBeats :: String -- ^ /beats/ child element
        , TimeSignature -> String
timeSignatureBeatType :: String -- ^ /beat-type/ child element
       }
    deriving (TimeSignature -> TimeSignature -> Bool
(TimeSignature -> TimeSignature -> Bool)
-> (TimeSignature -> TimeSignature -> Bool) -> Eq TimeSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeSignature -> TimeSignature -> Bool
$c/= :: TimeSignature -> TimeSignature -> Bool
== :: TimeSignature -> TimeSignature -> Bool
$c== :: TimeSignature -> TimeSignature -> Bool
Eq,Typeable,(forall x. TimeSignature -> Rep TimeSignature x)
-> (forall x. Rep TimeSignature x -> TimeSignature)
-> Generic TimeSignature
forall x. Rep TimeSignature x -> TimeSignature
forall x. TimeSignature -> Rep TimeSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TimeSignature x -> TimeSignature
$cfrom :: forall x. TimeSignature -> Rep TimeSignature x
Generic,Int -> TimeSignature -> ShowS
[TimeSignature] -> ShowS
TimeSignature -> String
(Int -> TimeSignature -> ShowS)
-> (TimeSignature -> String)
-> ([TimeSignature] -> ShowS)
-> Show TimeSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeSignature] -> ShowS
$cshowList :: [TimeSignature] -> ShowS
show :: TimeSignature -> String
$cshow :: TimeSignature -> String
showsPrec :: Int -> TimeSignature -> ShowS
$cshowsPrec :: Int -> TimeSignature -> ShowS
Show)
instance EmitXml TimeSignature where
    emitXml :: TimeSignature -> XmlRep
emitXml (TimeSignature String
a String
b) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beats" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"beat-type" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
b)])
parseTimeSignature :: P.XParse TimeSignature
parseTimeSignature :: XParse TimeSignature
parseTimeSignature = 
      String -> String -> TimeSignature
TimeSignature
        (String -> String -> TimeSignature)
-> XParse String -> XParse (String -> TimeSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beats") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))
        XParse (String -> TimeSignature)
-> XParse String -> XParse TimeSignature
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"beat-type") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'TimeSignature'
mkTimeSignature :: String -> String -> TimeSignature
mkTimeSignature :: String -> String -> TimeSignature
mkTimeSignature String
a String
b = String -> String -> TimeSignature
TimeSignature String
a String
b

-- | @traditional-key@ /(group)/
data TraditionalKey = 
      TraditionalKey {
          TraditionalKey -> Maybe Cancel
traditionalKeyCancel :: (Maybe Cancel) -- ^ /cancel/ child element
        , TraditionalKey -> Fifths
traditionalKeyFifths :: Fifths -- ^ /fifths/ child element
        , TraditionalKey -> Maybe Mode
traditionalKeyMode :: (Maybe Mode) -- ^ /mode/ child element
       }
    deriving (TraditionalKey -> TraditionalKey -> Bool
(TraditionalKey -> TraditionalKey -> Bool)
-> (TraditionalKey -> TraditionalKey -> Bool) -> Eq TraditionalKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraditionalKey -> TraditionalKey -> Bool
$c/= :: TraditionalKey -> TraditionalKey -> Bool
== :: TraditionalKey -> TraditionalKey -> Bool
$c== :: TraditionalKey -> TraditionalKey -> Bool
Eq,Typeable,(forall x. TraditionalKey -> Rep TraditionalKey x)
-> (forall x. Rep TraditionalKey x -> TraditionalKey)
-> Generic TraditionalKey
forall x. Rep TraditionalKey x -> TraditionalKey
forall x. TraditionalKey -> Rep TraditionalKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TraditionalKey x -> TraditionalKey
$cfrom :: forall x. TraditionalKey -> Rep TraditionalKey x
Generic,Int -> TraditionalKey -> ShowS
[TraditionalKey] -> ShowS
TraditionalKey -> String
(Int -> TraditionalKey -> ShowS)
-> (TraditionalKey -> String)
-> ([TraditionalKey] -> ShowS)
-> Show TraditionalKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraditionalKey] -> ShowS
$cshowList :: [TraditionalKey] -> ShowS
show :: TraditionalKey -> String
$cshow :: TraditionalKey -> String
showsPrec :: Int -> TraditionalKey -> ShowS
$cshowsPrec :: Int -> TraditionalKey -> ShowS
Show)
instance EmitXml TraditionalKey where
    emitXml :: TraditionalKey -> XmlRep
emitXml (TraditionalKey Maybe Cancel
a Fifths
b Maybe Mode
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([XmlRep -> (Cancel -> XmlRep) -> Maybe Cancel -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"cancel" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Cancel -> XmlRep) -> Cancel -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Cancel -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Cancel
a] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"fifths" Maybe String
forall a. Maybe a
Nothing) (Fifths -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Fifths
b)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Mode -> XmlRep) -> Maybe Mode -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"mode" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Mode -> XmlRep) -> Mode -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Mode -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Mode
c])
parseTraditionalKey :: P.XParse TraditionalKey
parseTraditionalKey :: XParse TraditionalKey
parseTraditionalKey = 
      Maybe Cancel -> Fifths -> Maybe Mode -> TraditionalKey
TraditionalKey
        (Maybe Cancel -> Fifths -> Maybe Mode -> TraditionalKey)
-> XParse (Maybe Cancel)
-> XParse (Fifths -> Maybe Mode -> TraditionalKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParse Cancel -> XParse (Maybe Cancel)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Cancel -> XParse Cancel
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"cancel") (XParse Cancel
parseCancel))
        XParse (Fifths -> Maybe Mode -> TraditionalKey)
-> XParse Fifths -> XParse (Maybe Mode -> TraditionalKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Fifths -> XParse Fifths
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"fifths") (XParse String
P.xtext XParse String -> (String -> XParse Fifths) -> XParse Fifths
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Fifths
parseFifths))
        XParse (Maybe Mode -> TraditionalKey)
-> XParse (Maybe Mode) -> XParse TraditionalKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Mode -> XParse (Maybe Mode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Mode -> XParse Mode
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"mode") (XParse String
P.xtext XParse String -> (String -> XParse Mode) -> XParse Mode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Mode
parseMode))

-- | Smart constructor for 'TraditionalKey'
mkTraditionalKey :: Fifths -> TraditionalKey
mkTraditionalKey :: Fifths -> TraditionalKey
mkTraditionalKey Fifths
b = Maybe Cancel -> Fifths -> Maybe Mode -> TraditionalKey
TraditionalKey Maybe Cancel
forall a. Maybe a
Nothing Fifths
b Maybe Mode
forall a. Maybe a
Nothing

-- | @tuning@ /(group)/
data Tuning = 
      Tuning {
          Tuning -> Step
tuningTuningStep :: Step -- ^ /tuning-step/ child element
        , Tuning -> Maybe Semitones
tuningTuningAlter :: (Maybe Semitones) -- ^ /tuning-alter/ child element
        , Tuning -> Octave
tuningTuningOctave :: Octave -- ^ /tuning-octave/ child element
       }
    deriving (Tuning -> Tuning -> Bool
(Tuning -> Tuning -> Bool)
-> (Tuning -> Tuning -> Bool) -> Eq Tuning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuning -> Tuning -> Bool
$c/= :: Tuning -> Tuning -> Bool
== :: Tuning -> Tuning -> Bool
$c== :: Tuning -> Tuning -> Bool
Eq,Typeable,(forall x. Tuning -> Rep Tuning x)
-> (forall x. Rep Tuning x -> Tuning) -> Generic Tuning
forall x. Rep Tuning x -> Tuning
forall x. Tuning -> Rep Tuning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tuning x -> Tuning
$cfrom :: forall x. Tuning -> Rep Tuning x
Generic,Int -> Tuning -> ShowS
[Tuning] -> ShowS
Tuning -> String
(Int -> Tuning -> ShowS)
-> (Tuning -> String) -> ([Tuning] -> ShowS) -> Show Tuning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tuning] -> ShowS
$cshowList :: [Tuning] -> ShowS
show :: Tuning -> String
$cshow :: Tuning -> String
showsPrec :: Int -> Tuning -> ShowS
$cshowsPrec :: Int -> Tuning -> ShowS
Show)
instance EmitXml Tuning where
    emitXml :: Tuning -> XmlRep
emitXml (Tuning Step
a Maybe Semitones
b Octave
c) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuning-step" Maybe String
forall a. Maybe a
Nothing) (Step -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Step
a)] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [XmlRep -> (Semitones -> XmlRep) -> Maybe Semitones -> XmlRep
forall b a. b -> (a -> b) -> Maybe a -> b
maybe XmlRep
XEmpty (QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuning-alter" Maybe String
forall a. Maybe a
Nothing)(XmlRep -> XmlRep) -> (Semitones -> XmlRep) -> Semitones -> XmlRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Semitones -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml) Maybe Semitones
b] [XmlRep] -> [XmlRep] -> [XmlRep]
forall a. [a] -> [a] -> [a]
++
        [QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"tuning-octave" Maybe String
forall a. Maybe a
Nothing) (Octave -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml Octave
c)])
parseTuning :: P.XParse Tuning
parseTuning :: XParse Tuning
parseTuning = 
      Step -> Maybe Semitones -> Octave -> Tuning
Tuning
        (Step -> Maybe Semitones -> Octave -> Tuning)
-> XParse Step -> XParse (Maybe Semitones -> Octave -> Tuning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse Step -> XParse Step
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuning-step") (XParse String
P.xtext XParse String -> (String -> XParse Step) -> XParse Step
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Step
parseStep))
        XParse (Maybe Semitones -> Octave -> Tuning)
-> XParse (Maybe Semitones) -> XParse (Octave -> Tuning)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XParse Semitones -> XParse (Maybe Semitones)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (QName -> XParse Semitones -> XParse Semitones
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuning-alter") (XParse String
P.xtext XParse String -> (String -> XParse Semitones) -> XParse Semitones
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Semitones
parseSemitones))
        XParse (Octave -> Tuning) -> XParse Octave -> XParse Tuning
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QName -> XParse Octave -> XParse Octave
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"tuning-octave") (XParse String
P.xtext XParse String -> (String -> XParse Octave) -> XParse Octave
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse Octave
parseOctave))

-- | Smart constructor for 'Tuning'
mkTuning :: Step -> Octave -> Tuning
mkTuning :: Step -> Octave -> Tuning
mkTuning Step
a Octave
c = Step -> Maybe Semitones -> Octave -> Tuning
Tuning Step
a Maybe Semitones
forall a. Maybe a
Nothing Octave
c

-- | @voice@ /(group)/
data Voice = 
      Voice {
          Voice -> String
voiceVoice :: String -- ^ /voice/ child element
       }
    deriving (Voice -> Voice -> Bool
(Voice -> Voice -> Bool) -> (Voice -> Voice -> Bool) -> Eq Voice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Voice -> Voice -> Bool
$c/= :: Voice -> Voice -> Bool
== :: Voice -> Voice -> Bool
$c== :: Voice -> Voice -> Bool
Eq,Typeable,(forall x. Voice -> Rep Voice x)
-> (forall x. Rep Voice x -> Voice) -> Generic Voice
forall x. Rep Voice x -> Voice
forall x. Voice -> Rep Voice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Voice x -> Voice
$cfrom :: forall x. Voice -> Rep Voice x
Generic,Int -> Voice -> ShowS
[Voice] -> ShowS
Voice -> String
(Int -> Voice -> ShowS)
-> (Voice -> String) -> ([Voice] -> ShowS) -> Show Voice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Voice] -> ShowS
$cshowList :: [Voice] -> ShowS
show :: Voice -> String
$cshow :: Voice -> String
showsPrec :: Int -> Voice -> ShowS
$cshowsPrec :: Int -> Voice -> ShowS
Show)
instance EmitXml Voice where
    emitXml :: Voice -> XmlRep
emitXml (Voice String
a) =
      XmlRep -> [XmlRep] -> [XmlRep] -> XmlRep
XContent XmlRep
XEmpty
        []
        ([QN -> XmlRep -> XmlRep
XElement (String -> Maybe String -> QN
QN String
"voice" Maybe String
forall a. Maybe a
Nothing) (String -> XmlRep
forall a. EmitXml a => a -> XmlRep
emitXml String
a)])
parseVoice :: P.XParse Voice
parseVoice :: XParse Voice
parseVoice = 
      String -> Voice
Voice
        (String -> Voice) -> XParse String -> XParse Voice
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> XParse String -> XParse String
forall a. QName -> XParse a -> XParse a
P.xchild (String -> QName
P.name String
"voice") (XParse String
P.xtext XParse String -> (String -> XParse String) -> XParse String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> XParse String
forall (m :: * -> *) a. Monad m => a -> m a
return))

-- | Smart constructor for 'Voice'
mkVoice :: String -> Voice
mkVoice :: String -> Voice
mkVoice String
a = String -> Voice
Voice String
a