module Main where

import IO
import System (getArgs)
--import List (isPrefixOf)

import Text.XML.HaXml.XmlContent

-- Test stuff
data MyType a = ConsA Int a
              | ConsB String
          {-! derive : XmlContent !-}

instance Eq a => Eq (MyType a) where
  (ConsA a b) == (ConsA c d) = a==c && b==d
  (ConsB e)   == (ConsB f)   = e `isPrefixOf` f || f `isPrefixOf` e
  _           == _           = False

{-
-- Hand-written example of preferred instance declaration.
instance Haskell2Xml a => Haskell2Xml (MyType a) where
    toHType v = Defined "MyType" [toHType a]
                    [Constr "ConsA" [toHType a] [Prim "Int" "int", toHType a]
                    ,Constr "ConsB" [] [String]
                    ]
              where (ConsA _ a) = v
    toContents v@(ConsA n a) = [mkElemC (showConstr 0 (toHType v))
                                  (concat [toContents n, toContents a])]
    toContents v@(ConsB s) = [mkElemC (showConstr 1 (toHType v)) (toContents s)]
    fromContents (CElem (Elem constr [] cs) : etc)
      | "ConsA-" `isPrefixOf` constr =
        (\(i,cs')-> (\(a,_) -> (ConsA i a,etc))
          (fromContents cs')) (fromContents cs)
      | "ConsB" `isPrefixOf` constr =
        (\(s,_)-> (ConsB s, etc)) (fromContents cs)
-}

value1 :: Maybe ([(Bool,Int)],(String,Maybe Char))
value1 = Just ([(True,42),(False,0)],("Hello World",Nothing))

value2 :: (MyType [Int], MyType ())
value2  = (ConsA 2 [42,0], ConsB "hello world")

value3 :: MyType [Int]
value3  = ConsA 2 [42,0]

-- Main wrapper
main =
  getArgs >>= \args->
  if length args /= 3 then
    putStrLn "Usage: <app> [1|2|3] [-w|-r] <xmlfile>"
  else
    let (arg0:arg1:arg2:_) = args in
    ( case arg1 of
         "-w"-> return (stdout,WriteMode)
         "-r"-> return (stdin,ReadMode)
         _   -> fail ("Usage: <app> [-r|-w] <xmlfile>") ) >>= \(std,mode)->
    ( if arg2=="-" then return std
      else openFile arg2 mode ) >>= \f->
    ( case arg0 of
         "1" -> checkValue f mode value1
         "2" -> checkValue f mode value2
         "3" -> checkValue f mode value3
         _   -> fail ("Usage: <app> [-r|-w] <xmlfile>") )

checkValue f mode value =
    case mode of
      WriteMode-> hPutXml f value
      ReadMode -> do ivalue <- hGetXml f
                     putStrLn (if ivalue==value then "success" else "failure")

--    WriteMode-> (hPutStrLn f . render . document . toXml) value1
--    ReadMode -> hGetContents f >>= \content ->
--                let ivalue = (fromXml . xmlParse) content in
--                (putStrLn . render . document . toXml) (ivalue `asTypeOf` value1) >>
--                putStrLn (if ivalue == value1 then "success" else "failure")


-- Machine generated stuff
{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
instance (Haskell2Xml a) => Haskell2Xml (MyType a) where
    toHType v =
	Defined "MyType" [a]
		[Constr "ConsA" [a] [toHType aa,toHType ab],
		 Constr "ConsB" [] [toHType ac]]
      where
	(ConsA aa ab) = v
	(ConsB ac) = v
	(a) = toHType ab
    fromContents (CElem (Elem constr [] cs):etc)
	| "ConsA" `isPrefixOf` constr =
	    (\(aa,cs00)-> (\(ab,_)-> (ConsA aa ab, etc)) (fromContents cs00))
	    (fromContents cs)
	| "ConsB" `isPrefixOf` constr =
	    (\(ac,_)-> (ConsB ac, etc)) (fromContents cs)
    fromContents (CElem (Elem constr _ _):etc) =
        error ("expected ConsA or ConsB, got "++constr)
    toContents v@(ConsA aa ab) =
	[mkElemC (showConstr 0 (toHType v)) (concat [toContents aa,
						     toContents ab])]
    toContents v@(ConsB ac) =
	[mkElemC (showConstr 1 (toHType v)) (toContents ac)]