module Script where
import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.OneOfN
data Script = Script Script_Attrs [Action]
deriving (Eq,Show)
data Script_Attrs = Script_Attrs
{ scriptAuthor :: (Maybe String)
, scriptDate :: (Maybe String)
, scriptDescription :: (Maybe String)
} deriving (Eq,Show)
data Action = Action Action_Attrs
[(OneOf7 Filter Reification Stat Parttime Timepart Haskore Midi)]
deriving (Eq,Show)
data Action_Attrs = Action_Attrs
{ actionInput :: String
, actionOutput :: (Maybe String)
, actionWarnings :: (Maybe Action_warnings)
} deriving (Eq,Show)
data Action_warnings = Action_warnings_yes | Action_warnings_no
deriving (Eq,Show)
data Filter = Filter
{ filterSelect :: Filter_select
, filterMode :: (Maybe Filter_mode)
} deriving (Eq,Show)
data Filter_select = Filter_select_note |
Filter_select_note_grace | Filter_select_note_cue |
Filter_select_note_normal
deriving (Eq,Show)
data Filter_mode = Filter_mode_yes | Filter_mode_no
deriving (Eq,Show)
data Reification = Reification
{ reificationValue :: Reification_value
} deriving (Eq,Show)
data Reification_value = Reification_value_1 |
Reification_value_2 | Reification_value_3 | Reification_value_4
| Reification_value_5
deriving (Eq,Show)
data Stat = Stat Stat_Attrs [Count]
deriving (Eq,Show)
data Stat_Attrs = Stat_Attrs
{ statVerbose :: (Maybe Stat_verbose)
} deriving (Eq,Show)
data Stat_verbose = Stat_verbose_yes | Stat_verbose_no
deriving (Eq,Show)
data Count = Count
{ countSelect :: Count_select
} deriving (Eq,Show)
data Count_select = Count_select_part | Count_select_measure |
Count_select_music_data | Count_select_note |
Count_select_note_grace | Count_select_note_cue |
Count_select_note_normal
deriving (Eq,Show)
data Parttime = Parttime deriving (Eq,Show)
data Timepart = Timepart deriving (Eq,Show)
data Haskore = Haskore deriving (Eq,Show)
data Midi = Midi
{ midiPlay :: (Maybe Midi_play)
} deriving (Eq,Show)
data Midi_play = Midi_play_yes | Midi_play_no
deriving (Eq,Show)
instance HTypeable Script where
toHType x = Defined "script" [] []
instance XmlContent Script where
toContents (Script as a) =
[CElem (Elem "script" (toAttrs as) (concatMap toContents a)) ()]
parseContents = do
{ e@(Elem _ as _) <- element ["script"]
; interior e $ return (Script (fromAttrs as))
`apply` many parseContents
} `adjustErr` ("in <script>, "++)
instance XmlAttributes Script_Attrs where
fromAttrs as =
Script_Attrs
{ scriptAuthor = possibleA fromAttrToStr "author" as
, scriptDate = possibleA fromAttrToStr "date" as
, scriptDescription = possibleA fromAttrToStr "description" as
}
toAttrs v = catMaybes
[ maybeToAttr toAttrFrStr "author" (scriptAuthor v)
, maybeToAttr toAttrFrStr "date" (scriptDate v)
, maybeToAttr toAttrFrStr "description" (scriptDescription v)
]
instance HTypeable Action where
toHType x = Defined "action" [] []
instance XmlContent Action where
toContents (Action as a) =
[CElem (Elem "action" (toAttrs as) (concatMap toContents a)) ()]
parseContents = do
{ e@(Elem _ as _) <- element ["action"]
; interior e $ return (Action (fromAttrs as))
`apply` many parseContents
} `adjustErr` ("in <action>, "++)
instance XmlAttributes Action_Attrs where
fromAttrs as =
Action_Attrs
{ actionInput = definiteA fromAttrToStr "action" "input" as
, actionOutput = possibleA fromAttrToStr "output" as
, actionWarnings = possibleA fromAttrToTyp "warnings" as
}
toAttrs v = catMaybes
[ toAttrFrStr "input" (actionInput v)
, maybeToAttr toAttrFrStr "output" (actionOutput v)
, maybeToAttr toAttrFrTyp "warnings" (actionWarnings v)
]
instance XmlAttrType Action_warnings where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "yes" = Just Action_warnings_yes
translate "no" = Just Action_warnings_no
translate _ = Nothing
toAttrFrTyp n Action_warnings_yes = Just (n, str2attr "yes")
toAttrFrTyp n Action_warnings_no = Just (n, str2attr "no")
instance HTypeable Filter where
toHType x = Defined "filter" [] []
instance XmlContent Filter where
toContents as =
[CElem (Elem "filter" (toAttrs as) []) ()]
parseContents = do
{ (Elem _ as []) <- element ["filter"]
; return (fromAttrs as)
} `adjustErr` ("in <filter>, "++)
instance XmlAttributes Filter where
fromAttrs as =
Filter
{ filterSelect = definiteA fromAttrToTyp "filter" "select" as
, filterMode = possibleA fromAttrToTyp "mode" as
}
toAttrs v = catMaybes
[ toAttrFrTyp "select" (filterSelect v)
, maybeToAttr toAttrFrTyp "mode" (filterMode v)
]
instance XmlAttrType Filter_select where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "note" = Just Filter_select_note
translate "note-grace" = Just Filter_select_note_grace
translate "note-cue" = Just Filter_select_note_cue
translate "note-normal" = Just Filter_select_note_normal
translate _ = Nothing
toAttrFrTyp n Filter_select_note = Just (n, str2attr "note")
toAttrFrTyp n Filter_select_note_grace = Just (n, str2attr "note-grace")
toAttrFrTyp n Filter_select_note_cue = Just (n, str2attr "note-cue")
toAttrFrTyp n Filter_select_note_normal = Just (n, str2attr "note-normal")
instance XmlAttrType Filter_mode where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "yes" = Just Filter_mode_yes
translate "no" = Just Filter_mode_no
translate _ = Nothing
toAttrFrTyp n Filter_mode_yes = Just (n, str2attr "yes")
toAttrFrTyp n Filter_mode_no = Just (n, str2attr "no")
instance HTypeable Reification where
toHType x = Defined "reification" [] []
instance XmlContent Reification where
toContents as =
[CElem (Elem "reification" (toAttrs as) []) ()]
parseContents = do
{ (Elem _ as []) <- element ["reification"]
; return (fromAttrs as)
} `adjustErr` ("in <reification>, "++)
instance XmlAttributes Reification where
fromAttrs as =
Reification
{ reificationValue = definiteA fromAttrToTyp "reification" "value" as
}
toAttrs v = catMaybes
[ toAttrFrTyp "value" (reificationValue v)
]
instance XmlAttrType Reification_value where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "1" = Just Reification_value_1
translate "2" = Just Reification_value_2
translate "3" = Just Reification_value_3
translate "4" = Just Reification_value_4
translate "5" = Just Reification_value_5
translate _ = Nothing
toAttrFrTyp n Reification_value_1 = Just (n, str2attr "1")
toAttrFrTyp n Reification_value_2 = Just (n, str2attr "2")
toAttrFrTyp n Reification_value_3 = Just (n, str2attr "3")
toAttrFrTyp n Reification_value_4 = Just (n, str2attr "4")
toAttrFrTyp n Reification_value_5 = Just (n, str2attr "5")
instance HTypeable Stat where
toHType x = Defined "stat" [] []
instance XmlContent Stat where
toContents (Stat as a) =
[CElem (Elem "stat" (toAttrs as) (concatMap toContents a)) ()]
parseContents = do
{ e@(Elem _ as _) <- element ["stat"]
; interior e $ return (Stat (fromAttrs as))
`apply` many parseContents
} `adjustErr` ("in <stat>, "++)
instance XmlAttributes Stat_Attrs where
fromAttrs as =
Stat_Attrs
{ statVerbose = possibleA fromAttrToTyp "verbose" as
}
toAttrs v = catMaybes
[ maybeToAttr toAttrFrTyp "verbose" (statVerbose v)
]
instance XmlAttrType Stat_verbose where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "yes" = Just Stat_verbose_yes
translate "no" = Just Stat_verbose_no
translate _ = Nothing
toAttrFrTyp n Stat_verbose_yes = Just (n, str2attr "yes")
toAttrFrTyp n Stat_verbose_no = Just (n, str2attr "no")
instance HTypeable Count where
toHType x = Defined "count" [] []
instance XmlContent Count where
toContents as =
[CElem (Elem "count" (toAttrs as) []) ()]
parseContents = do
{ (Elem _ as []) <- element ["count"]
; return (fromAttrs as)
} `adjustErr` ("in <count>, "++)
instance XmlAttributes Count where
fromAttrs as =
Count
{ countSelect = definiteA fromAttrToTyp "count" "select" as
}
toAttrs v = catMaybes
[ toAttrFrTyp "select" (countSelect v)
]
instance XmlAttrType Count_select where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "part" = Just Count_select_part
translate "measure" = Just Count_select_measure
translate "music-data" = Just Count_select_music_data
translate "note" = Just Count_select_note
translate "note-grace" = Just Count_select_note_grace
translate "note-cue" = Just Count_select_note_cue
translate "note-normal" = Just Count_select_note_normal
translate _ = Nothing
toAttrFrTyp n Count_select_part = Just (n, str2attr "part")
toAttrFrTyp n Count_select_measure = Just (n, str2attr "measure")
toAttrFrTyp n Count_select_music_data = Just (n, str2attr "music-data")
toAttrFrTyp n Count_select_note = Just (n, str2attr "note")
toAttrFrTyp n Count_select_note_grace = Just (n, str2attr "note-grace")
toAttrFrTyp n Count_select_note_cue = Just (n, str2attr "note-cue")
toAttrFrTyp n Count_select_note_normal = Just (n, str2attr "note-normal")
instance HTypeable Parttime where
toHType x = Defined "parttime" [] []
instance XmlContent Parttime where
toContents Parttime =
[CElem (Elem "parttime" [] []) ()]
parseContents = do
{ (Elem _ as []) <- element ["parttime"]
; return Parttime
} `adjustErr` ("in <parttime>, "++)
instance HTypeable Timepart where
toHType x = Defined "timepart" [] []
instance XmlContent Timepart where
toContents Timepart =
[CElem (Elem "timepart" [] []) ()]
parseContents = do
{ (Elem _ as []) <- element ["timepart"]
; return Timepart
} `adjustErr` ("in <timepart>, "++)
instance HTypeable Haskore where
toHType x = Defined "haskore" [] []
instance XmlContent Haskore where
toContents Haskore =
[CElem (Elem "haskore" [] []) ()]
parseContents = do
{ (Elem _ as []) <- element ["haskore"]
; return Haskore
} `adjustErr` ("in <haskore>, "++)
instance HTypeable Midi where
toHType x = Defined "midi" [] []
instance XmlContent Midi where
toContents as =
[CElem (Elem "midi" (toAttrs as) []) ()]
parseContents = do
{ (Elem _ as []) <- element ["midi"]
; return (fromAttrs as)
} `adjustErr` ("in <midi>, "++)
instance XmlAttributes Midi where
fromAttrs as =
Midi
{ midiPlay = possibleA fromAttrToTyp "play" as
}
toAttrs v = catMaybes
[ maybeToAttr toAttrFrTyp "play" (midiPlay v)
]
instance XmlAttrType Midi_play where
fromAttrToTyp n (n',v)
| n==n' = translate (attr2str v)
| otherwise = Nothing
where translate "yes" = Just Midi_play_yes
translate "no" = Just Midi_play_no
translate _ = Nothing
toAttrFrTyp n Midi_play_yes = Just (n, str2attr "yes")
toAttrFrTyp n Midi_play_no = Just (n, str2attr "no")