    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE FunctionalDependencies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    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 (Int -> ParseException -> ShowS
    [ParseException] -> ShowS
    ParseException -> String
    (Int -> ParseException -> ShowS)
    -> (ParseException -> String)
    -> ([ParseException] -> ShowS)
    -> Show ParseException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParseException -> ShowS
    showsPrec :: Int -> ParseException -> ShowS
    $cshow :: ParseException -> String
    show :: ParseException -> String
    $cshowList :: [ParseException] -> ShowS
    showList :: [ParseException] -> ShowS
    Show, Typeable, (forall x. ParseException -> Rep ParseException x)
    -> (forall x. Rep ParseException x -> ParseException)
    -> Generic ParseException
    forall x. Rep ParseException x -> ParseException
    forall x. ParseException -> Rep ParseException x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ParseException -> Rep ParseException x
    from :: forall x. ParseException -> Rep ParseException x
    $cto :: forall x. Rep ParseException x -> ParseException
    to :: forall x. Rep ParseException x -> ParseException
    Generic)

    instance Exception ParseException

    nodeElNameIs :: Node -> Name -> Bool
    nodeElNameIs :: Node -> Name -> Bool
    nodeElNameIs (NodeElement Element
    el) Name
    name = Element -> Name
    elementName Element
    el Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name
    nodeElNameIs Node
    _ Name
    _                   = Bool
    False

    class FromCursor a where
        fromCursor :: Cursor -> [a]

    class FromAttrVal a where
        fromAttrVal :: T.Reader a

    instance FromAttrVal Text where
        fromAttrVal :: Reader Text
    fromAttrVal = Reader Text
    forall a. a -> Either String (a, Text)
    readSuccess

    instance FromAttrVal Int where
        fromAttrVal :: Reader Int
    fromAttrVal = Reader Int -> Reader Int
    forall a. Num a => Reader a -> Reader a
    T.signed Reader Int
    forall a. Integral a => Reader a
    T.decimal

    instance FromAttrVal Integer where
        fromAttrVal :: Reader Integer
    fromAttrVal = Reader Integer -> Reader Integer
    forall a. Num a => Reader a -> Reader a
    T.signed Reader Integer
    forall a. Integral a => Reader a
    T.decimal

    instance FromAttrVal Double where
        fromAttrVal :: Reader Double
    fromAttrVal = Reader Double
    forall a. Fractional a => Reader a
    T.rational

    instance FromAttrVal Bool where
        fromAttrVal :: Reader Bool
    fromAttrVal Text
    x | Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "1" Bool -> Bool -> Bool
    || Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "true"  = Bool -> Either String (Bool, Text)
    forall a. a -> Either String (a, Text)
    readSuccess Bool
    True
                      | Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "0" Bool -> Bool -> Bool
    || Text
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "false" = Bool -> Either String (Bool, Text)
    forall a. a -> Either String (a, Text)
    readSuccess Bool
    False
                      | Bool
    otherwise                = Either String (Bool, Text)
    forall a. Either String (a, Text)
    defaultReadFailure

    -- | required attribute parsing
    fromAttribute :: FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute :: forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    name Cursor
    cursor =
        Name -> Cursor -> [Text]
    attribute Name
    name Cursor
    cursor [Text] -> (Text -> [a]) -> [a]
    forall a b. [a] -> (a -> [b]) -> [b]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Reader a -> Text -> [a]
    forall a. Reader a -> Text -> [a]
    runReader Reader a
    forall a. FromAttrVal a => Reader a
    fromAttrVal

    -- | parsing optional attributes with defaults
    fromAttributeDef :: FromAttrVal a => Name -> a -> Cursor -> [a]
    fromAttributeDef :: forall a. FromAttrVal a => Name -> a -> Cursor -> [a]
    fromAttributeDef Name
    name a
    defVal Cursor
    cursor =
        case Name -> Cursor -> [Text]
    attribute Name
    name Cursor
    cursor of
          [Text
    attr] -> Reader a -> Text -> [a]
    forall a. Reader a -> Text -> [a]
    runReader Reader a
    forall a. FromAttrVal a => Reader a
    fromAttrVal Text
    attr
          [Text]
    _      -> [a
    defVal]

    -- | parsing optional attributes
    maybeAttribute :: FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute :: forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute Name
    name Cursor
    cursor =
        case Name -> Cursor -> [Text]
    attribute Name
    name Cursor
    cursor of
          [Text
    attr] -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> [a] -> [Maybe a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Reader a -> Text -> [a]
    forall a. Reader a -> Text -> [a]
    runReader Reader a
    forall a. FromAttrVal a => Reader a
    fromAttrVal Text
    attr
          [Text]
    _ -> [Maybe a
    forall a. Maybe a
    Nothing]

    fromElementValue :: FromAttrVal a => Name -> Cursor -> [a]
    fromElementValue :: forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromElementValue Name
    name Cursor
    cursor =
        Cursor
    cursor Cursor -> (Cursor -> [a]) -> [a]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    name Axis -> (Cursor -> [a]) -> Cursor -> [a]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Name -> Cursor -> [a]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    "val"

    maybeElementValue :: FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeElementValue :: forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeElementValue Name
    name Cursor
    cursor =
      case Cursor
    cursor Cursor -> Axis -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    name of
        [Cursor
    cursor'] -> Name -> Cursor -> [Maybe a]
    forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute Name
    "val" Cursor
    cursor'
        [Cursor]
    _ -> [Maybe a
    forall a. Maybe a
    Nothing]

    maybeElementValueDef :: FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
    maybeElementValueDef :: forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
    maybeElementValueDef Name
    name a
    defVal Cursor
    cursor =
      case Cursor
    cursor Cursor -> Axis -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    name of
        [Cursor
    cursor'] -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> (Maybe a -> a) -> Maybe a -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    defVal (Maybe a -> Maybe a) -> [Maybe a] -> [Maybe a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Cursor -> [Maybe a]
    forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
    maybeAttribute Name
    "val" Cursor
    cursor'
        [Cursor]
    _ -> [Maybe a
    forall a. Maybe a
    Nothing]

    maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool]
    maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool]
    maybeBoolElementValue Name
    name Cursor
    cursor = Name -> Bool -> Cursor -> [Maybe Bool]
    forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
    maybeElementValueDef Name
    name Bool
    True Cursor
    cursor

    maybeFromElement :: FromCursor a => Name -> Cursor -> [Maybe a]
    maybeFromElement :: forall a. FromCursor a => Name -> Cursor -> [Maybe a]
    maybeFromElement Name
    name Cursor
    cursor = case Cursor
    cursor Cursor -> Axis -> [Cursor]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Name -> Axis
    element Name
    name of
      [Cursor
    cursor'] -> a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> [a] -> [Maybe a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Cursor -> [a]
    forall a. FromCursor a => Cursor -> [a]
    fromCursor Cursor
    cursor'
      [Cursor]
    _ -> [Maybe a
    forall a. Maybe a
    Nothing]

    attrValIs :: (Eq a, FromAttrVal a) => Name -> a -> Axis
    attrValIs :: forall a. (Eq a, FromAttrVal a) => Name -> a -> Axis
    attrValIs Name
    n a
    v Cursor
    c =
      case Name -> Cursor -> [a]
    forall a. FromAttrVal a => Name -> Cursor -> [a]
    fromAttribute Name
    n Cursor
    c of
        [a
    x] | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    v -> [Cursor
    c]
        [a]
    _ -> []

    contentOrEmpty :: Cursor -> [Text]
    contentOrEmpty :: Cursor -> [Text]
    contentOrEmpty Cursor
    c =
      case Cursor
    c Cursor -> (Cursor -> [Text]) -> [Text]
    forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
    $/ Cursor -> [Text]
    content of
        [Text
    t] -> [Text
    t]
        [] -> [Text
    ""]
        [Text]
    _ -> String -> [Text]
    forall a. HasCallStack => String -> a
    error String
    "invalid item: more than one text node encountered"

    readSuccess :: a -> Either String (a, Text)
    readSuccess :: forall a. a -> Either String (a, Text)
    readSuccess a
    x = (a, Text) -> Either String (a, Text)
    forall a b. b -> Either a b
    Right (a
    x, Text
    T.empty)

    readFailure :: Text -> Either String (a, Text)
    readFailure :: forall a. Text -> Either String (a, Text)
    readFailure = String -> Either String (a, Text)
    forall a b. a -> Either a b
    Left (String -> Either String (a, Text))
    -> (Text -> String) -> Text -> Either String (a, Text)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack

    invalidText :: Text -> Text -> Either String (a, Text)
    invalidText :: forall a. Text -> Text -> Either String (a, Text)
    invalidText Text
    what Text
    txt = Text -> Either String (a, Text)
    forall a. Text -> Either String (a, Text)
    readFailure (Text -> Either String (a, Text))
    -> Text -> Either String (a, Text)
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat [Text
    "Invalid ", Text
    what, Text
    ": '", Text
    txt , Text
    "'"]

    defaultReadFailure :: Either String (a, Text)
    defaultReadFailure :: forall a. Either String (a, Text)
    defaultReadFailure = String -> Either String (a, Text)
    forall a b. a -> Either a b
    Left String
    "invalid text"

    runReader :: T.Reader a -> Text -> [a]
    runReader :: forall a. Reader a -> Text -> [a]
    runReader Reader a
    reader Text
    t = case Reader a
    reader Text
    t of
      Right (a
    r, Text
    leftover) | Text -> Bool
    T.null Text
    leftover -> [a
    r]
      Either String (a, Text)
    _ -> []

    -- | Add sml namespace to name
    n_ :: Text -> Name
    n_ :: Text -> Name
    n_ Text
    x = Name
      { nameLocalName :: Text
    nameLocalName = Text
    x
      , nameNamespace :: Maybe Text
    nameNamespace = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "http://schemas.openxmlformats.org/spreadsheetml/2006/main"
      , namePrefix :: Maybe Text
    namePrefix = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "n"
      }