module Text.XML.DOM.Parser.FromDom
  ( -- * FromDom
    FromDom(..)
  , proxyFromDom
    -- * Explicit methods for convenience
  , elementFromDom
  , textFromDom
  , stringFromDom
  , charFromDom
  , intFromDom
  , integerFromDom
  , doubleFromDom
  , fixedFromDom
  , boolFromDom
  , unitFromDom
  , voidFromDom
  , scientificFromDom
  ) where

import Control.Applicative
import Control.Lens
import Data.Fixed
import Data.Scientific
import Data.Text as T hiding (empty)
import Data.Typeable
import Data.Void
import Text.XML
import Text.XML.DOM.Parser.Content
import Text.XML.DOM.Parser.Types

proxyFromDom
  :: forall proxy m a
   . (FromDom a, Monad m)
  => proxy a
  -> DomParserT Identity m a
proxyFromDom _ = fromDom

-- | Class of types which can be parsed from single XML element. The
-- method 'fromDom' is convenient default to use with 'inElem'
class FromDom a where
  fromDom :: (Monad m) => DomParserT Identity m a

instance FromDom () where
  fromDom = unitFromDom

-- | Always successfully parses any DOM to @()@
unitFromDom :: (Monad m) => DomParserT Identity m  ()
unitFromDom = pure ()

instance FromDom Void where
  fromDom = voidFromDom

-- | Never parses successfully. It is just 'empty'
voidFromDom :: (Monad m) => DomParserT Identity m  Void
voidFromDom = empty

instance FromDom Text where
  fromDom = textFromDom

textFromDom :: (Monad m) => DomParserT Identity m Text
textFromDom = parseContent Right

instance FromDom String where
  fromDom = stringFromDom

stringFromDom :: (Monad m) => DomParserT Identity m String
stringFromDom = parseContent $ Right . T.unpack

instance FromDom Char where
  fromDom = charFromDom

charFromDom :: (Monad m) => DomParserT Identity m Char
charFromDom = parseContent readChar

instance FromDom Int where
  fromDom = intFromDom

intFromDom :: (Monad m) => DomParserT Identity m Int
intFromDom = parseContent readContent

instance FromDom Integer where
  fromDom = integerFromDom

integerFromDom :: (Monad m) => DomParserT Identity m Integer
integerFromDom = parseContent readContent

instance FromDom Double where
  fromDom = doubleFromDom

doubleFromDom :: (Monad m) => DomParserT Identity m Double
doubleFromDom = parseContent readContent

instance (HasResolution a, Typeable a) => FromDom (Fixed a) where
  fromDom = fixedFromDom

fixedFromDom
  :: (Monad m, Typeable a, HasResolution a)
  => DomParserT Identity m (Fixed a)
fixedFromDom = parseContent readContent

instance FromDom Scientific where
  fromDom = scientificFromDom

scientificFromDom :: Monad m => DomParserT Identity m Scientific
scientificFromDom = parseContent readContent

instance FromDom Bool where
  fromDom = boolFromDom

-- | Expects content to be y, yes, t, true or 1 for True Values n, no,
-- f, false or 0 for False. Case is not significant, blank characters
-- are striped.
boolFromDom :: (Monad m) => DomParserT Identity m Bool
boolFromDom = parseContent readBool

instance FromDom Element where
  fromDom = elementFromDom

elementFromDom :: (Monad m) => DomParserT Identity m Element
elementFromDom = view $ pdElements . to runIdentity