module Script where

import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.OneOfN


{-Type decls-}

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 decls-}

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



{-Done-}