content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  module Codec.Xlsx.Parser.Internal
    ( ParseException(..)
    , n_
    , addSmlNamespace
    , nodeElNameIs
    , FromCursor(..)
    , FromAttrVal(..)
    , fromAttribute
    , fromAttributeDef
    , maybeAttribute
    , fromElementValue
    , maybeElementValue
    , maybeElementValueDef
    , maybeBoolElementValue
    , maybeFromElement
    , attrValIs
    , contentOrEmpty
    , readSuccess
    , readFailure
    , invalidText
    , defaultReadFailure
    , module Codec.Xlsx.Parser.Internal.Util
    , module Codec.Xlsx.Parser.Internal.Fast
    ) where
  
  import Control.Exception (Exception)
  import Data.Maybe
  import Data.Text (Text)
  import qualified Data.Text as T
  import qualified Data.Text.Read as T
  import Data.Typeable (Typeable)
  import GHC.Generics (Generic)
  import Text.XML
  import Text.XML.Cursor
  
  import Codec.Xlsx.Writer.Internal
  import Codec.Xlsx.Parser.Internal.Fast
  import Codec.Xlsx.Parser.Internal.Util
  
  data ParseException = ParseException String
                      deriving (Show, Typeable, Generic)
  
  instance Exception ParseException
  
  nodeElNameIs :: Node -> Name -> Bool
  nodeElNameIs (NodeElement el) name = elementName el == name
  nodeElNameIs _ _                   = False
  
  class FromCursor a where
      fromCursor :: Cursor -> [a]
  
  class FromAttrVal a where
      fromAttrVal :: T.Reader a
  
  instance FromAttrVal Text where
      fromAttrVal = readSuccess
  
  instance FromAttrVal Int where
      fromAttrVal = T.signed T.decimal
  
  instance FromAttrVal Integer where
      fromAttrVal = T.signed T.decimal
  
  instance FromAttrVal Double where
      fromAttrVal = T.rational
  
  instance FromAttrVal Bool where
      fromAttrVal x | x == "1" || x == "true"  = readSuccess True
                    | x == "0" || x == "false" = readSuccess False
                    | otherwise                = defaultReadFailure
  
  -- | required attribute parsing
  fromAttribute :: FromAttrVal a => Name -> Cursor -> [a]
  fromAttribute name cursor =
      attribute name cursor >>= runReader fromAttrVal
  
  -- | parsing optional attributes with defaults
  fromAttributeDef :: FromAttrVal a => Name -> a -> Cursor -> [a]
  fromAttributeDef name defVal cursor =
      case attribute name cursor of
        [attr] -> runReader fromAttrVal attr
        _      -> [defVal]
  
  -- | parsing optional attributes
  maybeAttribute :: FromAttrVal a => Name -> Cursor -> [Maybe a]
  maybeAttribute name cursor =
      case attribute name cursor of
        [attr] -> Just <$> runReader fromAttrVal attr
        _ -> [Nothing]
  
  fromElementValue :: FromAttrVal a => Name -> Cursor -> [a]
  fromElementValue name cursor =
      cursor $/ element name >=> fromAttribute "val"
  
  maybeElementValue :: FromAttrVal a => Name -> Cursor -> [Maybe a]
  maybeElementValue name cursor =
    case cursor $/ element name of
      [cursor'] -> maybeAttribute "val" cursor'
      _ -> [Nothing]
  
  maybeElementValueDef :: FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
  maybeElementValueDef name defVal cursor =
    case cursor $/ element name of
      [cursor'] -> Just . fromMaybe defVal <$> maybeAttribute "val" cursor'
      _ -> [Nothing]
  
  maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool]
  maybeBoolElementValue name cursor = maybeElementValueDef name True cursor
  
  maybeFromElement :: FromCursor a => Name -> Cursor -> [Maybe a]
  maybeFromElement name cursor = case cursor $/ element name of
    [cursor'] -> Just <$> fromCursor cursor'
    _ -> [Nothing]
  
  attrValIs :: (Eq a, FromAttrVal a) => Name -> a -> Axis
  attrValIs n v c =
    case fromAttribute n c of
      [x] | x == v -> [c]
      _ -> []
  
  contentOrEmpty :: Cursor -> [Text]
  contentOrEmpty c =
    case c $/ content of
      [t] -> [t]
      [] -> [""]
      _ -> error "invalid item: more than one text node encountered"
  
  readSuccess :: a -> Either String (a, Text)
  readSuccess x = Right (x, T.empty)
  
  readFailure :: Text -> Either String (a, Text)
  readFailure = Left . T.unpack
  
  invalidText :: Text -> Text -> Either String (a, Text)
  invalidText what txt = readFailure $ T.concat ["Invalid ", what, ": '", txt , "'"]
  
  defaultReadFailure :: Either String (a, Text)
  defaultReadFailure = Left "invalid text"
  
  runReader :: T.Reader a -> Text -> [a]
  runReader reader t = case reader t of
    Right (r, leftover) | T.null leftover -> [r]
    _ -> []
  
  
  {-# DEPRECATED n_ "Renamed to addSmlNamespace" #-}
  n_ :: Text -> Name
  n_ = addSmlNamespace
  
  -- | Add sml namespace to name
  addSmlNamespace :: Text -> Name
  addSmlNamespace x = Name
    { nameLocalName = x
    , nameNamespace = Just mainNamespace
    , namePrefix = Nothing
    }
  