{-# 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
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
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]
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)
_ -> []
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"
}