module Codec.Xlsx.Parser.Internal
( ParseException(..)
, n_
, 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.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
fromAttribute :: FromAttrVal a => Name -> Cursor -> [a]
fromAttribute name cursor =
attribute name cursor >>= runReader fromAttrVal
fromAttributeDef :: FromAttrVal a => Name -> a -> Cursor -> [a]
fromAttributeDef name defVal cursor =
case attribute name cursor of
[attr] -> runReader fromAttrVal attr
_ -> [defVal]
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]
_ -> []
n_ :: Text -> Name
n_ x = Name
{ nameLocalName = x
, nameNamespace = Just "http://schemas.openxmlformats.org/spreadsheetml/2006/main"
, namePrefix = Just "n"
}