{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show, Typeable, 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
$cto :: forall x. Rep ParseException x -> ParseException
$cfrom :: forall x. ParseException -> Rep ParseException x
Generic)

instance Exception ParseException

nodeElNameIs :: Node -> Name -> Bool
nodeElNameIs :: Node -> Name -> Bool
nodeElNameIs (NodeElement Element
el) Name
name = Element -> Name
elementName Element
el 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 = forall a. a -> Either String (a, Text)
readSuccess

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

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

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

instance FromAttrVal Bool where
    fromAttrVal :: Reader Bool
fromAttrVal Text
x | Text
x forall a. Eq a => a -> a -> Bool
== Text
"1" Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"true"  = forall a. a -> Either String (a, Text)
readSuccess Bool
True
                  | Text
x forall a. Eq a => a -> a -> Bool
== Text
"0" Bool -> Bool -> Bool
|| Text
x forall a. Eq a => a -> a -> Bool
== Text
"false" = forall a. a -> Either String (a, Text)
readSuccess Bool
False
                  | Bool
otherwise                = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Reader a -> Text -> [a]
runReader 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] -> forall a. Reader a -> Text -> [a]
runReader 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] -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Reader a -> Text -> [a]
runReader forall a. FromAttrVal a => Reader a
fromAttrVal Text
attr
      [Text]
_ -> [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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
name forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
name of
    [Cursor
cursor'] -> forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"val" Cursor
cursor'
    [Cursor]
_ -> [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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
name of
    [Cursor
cursor'] -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe a
defVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeAttribute Name
"val" Cursor
cursor'
    [Cursor]
_ -> [forall a. Maybe a
Nothing]

maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue :: Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue Name
name Cursor
cursor = 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
name of
  [Cursor
cursor'] -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromCursor a => Cursor -> [a]
fromCursor Cursor
cursor'
  [Cursor]
_ -> [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 forall a. FromAttrVal a => Name -> Cursor -> [a]
fromAttribute Name
n Cursor
c of
    [a
x] | a
x forall a. Eq a => a -> a -> Bool
== a
v -> [Cursor
c]
    [a]
_ -> []

contentOrEmpty :: Cursor -> [Text]
contentOrEmpty :: Cursor -> [Text]
contentOrEmpty Cursor
c =
  case Cursor
c forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content of
    [Text
t] -> [Text
t]
    [] -> [Text
""]
    [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 = 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 = forall a b. a -> Either a b
Left 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 = forall a. Text -> Either String (a, Text)
readFailure 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 = 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 = forall a. a -> Maybe a
Just Text
"http://schemas.openxmlformats.org/spreadsheetml/2006/main"
  , namePrefix :: Maybe Text
namePrefix = forall a. a -> Maybe a
Just Text
"n"
  }