-- |  
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: HaXML
-- 
module Text.XML.MusicXML (
    module Text.XML.MusicXML,
    module Text.XML.MusicXML.Common,
    module Text.XML.MusicXML.Attributes,
    module Text.XML.MusicXML.Identity,
    module Text.XML.MusicXML.Barline,
    module Text.XML.MusicXML.Link,
    module Text.XML.MusicXML.Direction,
    module Text.XML.MusicXML.Layout,
    module Text.XML.MusicXML.Note,
    module Text.XML.MusicXML.Score,
    module Text.XML.MusicXML.Partwise,
    module Text.XML.MusicXML.Timewise,
) where
import Prelude (IO, Int, String, FilePath, 
    Monad(..), Show(..), Eq(..), Ord(..), 
    Maybe(..), Bool(..), 
    either, maybe, otherwise, fromEnum, snd, mapM, 
    readFile, writeFile, 
    (.), (++), (+))                                     -- base package
import qualified Data.Map as Map                        -- containers package
import Control.Monad (MonadPlus(..))                    -- base package
import System.Time (CalendarTime(..), 
    getClockTime, toCalendarTime)                       -- old-time package
import System.Directory (doesFileExist)                 -- directory package
import Text.PrettyPrint.HughesPJ                        -- pretty package
import Text.XML.HaXml.Types                             -- HaXml package
import Text.XML.HaXml.Parse (xmlParse')                 -- HaXml package
import Text.XML.HaXml.Pretty (document)                 -- HaXml package
import Text.XML.HaXml.Posn (Posn, noPos)                -- HaXml package
import Text.XML.MusicXML.Common hiding 
    ( Tenths, read_Tenths, show_Tenths, 
    Directive, read_Directive, show_Directive)          -- MusicXML package
import Text.XML.MusicXML.Attributes                     -- MusicXML package
import Text.XML.MusicXML.Barline                        -- MusicXML package
import Text.XML.MusicXML.Link                           -- MusicXML package
import Text.XML.MusicXML.Direction                      -- MusicXML package
import Text.XML.MusicXML.Identity                       -- MusicXML package
import Text.XML.MusicXML.Layout                         -- MusicXML package
import Text.XML.MusicXML.Note                           -- MusicXML package
import Text.XML.MusicXML.Score hiding
    (Opus, read_Opus, show_Opus)                        -- MusicXML package
import Text.XML.MusicXML.Partwise hiding
    (doctype, Part, read_Part, show_Part, 
    Measure, read_Measure, show_Measure)                -- MusicXML package
import Text.XML.MusicXML.Timewise hiding 
    (doctype, Part, read_Part, show_Part, 
    Measure, read_Measure, show_Measure)                -- MusicXML package
import Text.XML.MusicXML.Opus hiding 
    (doctype)                                           -- MusicXML package
import Text.XML.MusicXML.Container hiding
    (doctype)                                           -- MusicXML package

import qualified Text.XML.MusicXML.Partwise  as Partwise    -- MusicXML package
import qualified Text.XML.MusicXML.Timewise  as Timewise    -- MusicXML package
import qualified Text.XML.MusicXML.Opus      as Opus        -- MusicXML package
import qualified Text.XML.MusicXML.Container as Container   -- MusicXML package

-- * MusicXML
-- |
data ScoreDoc = Partwise Score_Partwise
              | Timewise Score_Timewise
                deriving (Eq, Show)
data MusicXMLDoc = Score ScoreDoc
                 | Opus Opus
                 | Container Container
                   deriving (Eq, Show)
-- |
data MusicXMLRec = MusicXMLRec (Map.Map FilePath MusicXMLDoc)
                   deriving (Eq, Show)

-- |
read_DOCUMENT :: StateT Result [Content Posn] a -> Document Posn -> Result a
read_DOCUMENT r (Document _ _ x _) = stateT r [CElem x noPos] >>= (return.snd)
-- |
read_MusicXML_Partwise :: Document Posn -> Result Score_Partwise
read_MusicXML_Partwise = read_DOCUMENT read_Score_Partwise
-- |
read_MusicXML_Timewise :: Document Posn -> Result Score_Timewise
read_MusicXML_Timewise = read_DOCUMENT read_Score_Timewise
-- |
read_MusicXML_Opus :: Document Posn -> Result Opus
read_MusicXML_Opus = read_DOCUMENT read_Opus
-- |
read_MusicXML_Container :: Document Posn -> Result Container
read_MusicXML_Container = read_DOCUMENT read_Container
-- |
show_DOCUMENT :: DocTypeDecl -> (t -> [Content i]) -> t -> Result (Document i)
show_DOCUMENT doct f doc = 
    case f doc of
        [(CElem processed _)] -> 
            return (Document (Prolog (Just xmldecl) [] 
                    (Just doct) []) [] processed [])
        _                     -> fail "internal error"
-- |
show_MusicXML_Partwise :: Score_Partwise -> Result (Document ())
show_MusicXML_Partwise = 
    show_DOCUMENT Partwise.doctype show_Score_Partwise 
-- |
show_MusicXML_Timewise :: Score_Timewise -> Result (Document ())
show_MusicXML_Timewise = 
    show_DOCUMENT Partwise.doctype show_Score_Timewise 
-- |
show_MusicXML_Opus :: Opus -> Result (Document ())
show_MusicXML_Opus x = 
    show_DOCUMENT Opus.doctype show_Opus x
-- |
show_MusicXML_Container :: Container -> Result (Document ())
show_MusicXML_Container x = 
    show_DOCUMENT Container.doctype show_Container x
-- |
update_MusicXML_Partwise :: ([Software], Encoding_Date) -> 
    Score_Partwise -> Score_Partwise
update_MusicXML_Partwise = update_Score_Partwise 
-- |
update_MusicXML_Timewise :: ([Software], Encoding_Date) -> 
    Score_Timewise -> Score_Timewise
update_MusicXML_Timewise = update_Score_Timewise 

-- |
read_MusicXMLDoc :: Document Posn -> Result MusicXMLDoc
read_MusicXMLDoc doc = 
  (read_DOCUMENT read_Score_Partwise doc >>= return .Score .Partwise) `mplus`
  (read_DOCUMENT read_Score_Timewise doc >>= return .Score .Timewise) `mplus`
  (read_DOCUMENT read_Opus doc >>= return . Opus) `mplus`
  (read_DOCUMENT read_Container doc >>= return . Container) `mplus`
  fail "<score-partwise> or <score-timewise> or <opus> or <container>"
-- |
show_MusicXMLDoc :: MusicXMLDoc -> Result (Document ())
show_MusicXMLDoc (Score (Partwise doc)) = show_MusicXML_Partwise doc
show_MusicXMLDoc (Score (Timewise doc)) = show_MusicXML_Timewise doc
show_MusicXMLDoc (Opus doc) = show_MusicXML_Opus doc
show_MusicXMLDoc (Container doc) = show_MusicXML_Container doc
-- |
update_MusicXMLDoc :: ([Software], Encoding_Date) -> 
    MusicXMLDoc -> MusicXMLDoc
update_MusicXMLDoc x (Score (Partwise doc)) = 
    Score (Partwise (update_MusicXML_Partwise x doc))
update_MusicXMLDoc x (Score (Timewise doc)) = 
    Score (Timewise (update_MusicXML_Timewise x doc))
update_MusicXMLDoc _ y = y
-- |
read_MusicXMLRec :: FilePath -> IO (Map.Map FilePath MusicXMLDoc)
read_MusicXMLRec f = do
    x <- read_FILE read_MusicXMLDoc f >>= \a -> return (f, a)
    case isOK (snd x) of
        True -> do 
            xs <- mapM (\f' -> read_FILE read_MusicXMLDoc f' 
                            >>= \a -> return (f', a))
                    (Text.XML.MusicXML.getFiles (fromOK (snd x)))
            return (Map.map fromOK (Map.filter isOK (Map.fromList (x:xs))))
        False -> return (Map.empty)

-- |
read_CONTENTS :: (Document Posn -> Result a) -> 
    FilePath -> Prelude.String -> Result a
read_CONTENTS f filepath contents = 
    either fail f (xmlParse' filepath contents)
-- |
show_CONTENTS :: (a -> Result (Document i)) -> a -> Prelude.String
show_CONTENTS f musicxml = 
    maybe (fail "undefined error") 
        (renderStyle (Style LeftMode 100 1.5) . document) 
        ((toMaybe . f) musicxml)
-- |
read_FILE :: (Document Posn -> Result a) -> FilePath -> IO (Result a)
read_FILE f filepath = do
    exists <- doesFileExist filepath
    case exists of
        True -> readFile filepath >>= return . (read_CONTENTS f) filepath
        False -> (return . fail) ("no file: " ++ show filepath)
-- |
show_FILE :: (a -> Result (Document i)) -> FilePath -> a -> IO ()
show_FILE f filepath musicxml = 
    writeFile filepath (show_CONTENTS f musicxml)

-- |
xmldecl :: XMLDecl
xmldecl = XMLDecl "1.0" Nothing Nothing
-- |
getFiles :: MusicXMLDoc -> [FilePath]
getFiles (Score _) = []
getFiles (Opus x) = Text.XML.MusicXML.Opus.getFiles x
getFiles (Container x) = Text.XML.MusicXML.Container.getFiles x
-- |
toMaybe :: Result a -> Maybe a
toMaybe (Ok x) = Just x
toMaybe (Error _) = Nothing
-- | getTime uses old-time library. At future versions can be defined as:
--  @getTime :: IO Prelude.String@
--  @getTime = getCurrentTime >>= return . show . utctDay@
getTime :: IO Encoding_Date
getTime = getClockTime >>= toCalendarTime >>= 
    return . (\(CalendarTime yyyy mm dd _ _ _ _ _ _ _ _ _) ->
        show4 yyyy ++ "-" ++ show2 (fromEnum mm + 1) ++ "-" ++ show2 dd)
-- |
show2, show3, show4 :: Int -> Prelude.String
show2 x | (x < 0) = show2 (-x)
        | otherwise = case show x of; [a] -> '0':a:[]; y -> y
show3 x | (x < 0) = show3 (-x)
        | otherwise = case show2 x of; [a,b] -> '0':a:b:[]; y -> y
show4 x | (x < 0) = show4 (-x)
        | otherwise = case show3 x of; [a,b,c] -> '0':a:b:c:[]; y -> y