module Language.Ruby.Parser.Builder where

import Data.Ratio (Rational)
import Data.Complex
import Data.List (nub)

import Language.Ruby.AST (Term (..))
import Language.Ruby.Parser.Lexer (Token (..))

lvasgn name = Lvasgn name . Just
ivasgn name = Ivasgn name . Just
cvasgn name = Cvasgn name . Just
gvasgn name = Gvasgn name . Just
casgn name parent = Casgn name parent . Just

type StaticEnv = [String]

mkLogicalOp :: (Term -> Term -> Term) -> Term -> Term -> Term
mkLogicalOp = id

mkExpression :: [Term] -> Term
mkExpression []  = Nil
mkExpression [e] = e
mkExpression xs  = Begin xs

mk_multiassign :: Term -> Term -> Term
mk_multiassign = Masgn

mk_postexe :: Term -> Term
mk_postexe = Postexe

mk_accessible :: Term -> StaticEnv -> Term
mk_accessible (Lvar name) env | elem name env = Send Nil name []
mk_accessible term        _   = term

mk_alias :: Term -> Term -> Term
mk_alias = Alias

mk_arg :: Token -> Term
mk_arg = Arg . value

mk_args :: [Term] -> Term
mk_args args
  | has_duplicate_args args = error "duplicate argument"
  | otherwise               = Args args

has_duplicate_args :: [Term] -> Bool
has_duplicate_args args = has_non_ignored_duplicates . concatMap arg_names $ args
  where has_non_ignored_duplicates       = has_duplicates . filter (not . starts_with_underscore)

        starts_with_underscore ('_' : _) = True
        starts_with_underscore _         = False

        has_duplicates a_list            = nub a_list == a_list

        arg_names (Mlhs terms) = map arg_name terms
        arg_names arg          = [arg_name arg]

mk_array :: [Term] -> Term
mk_array = RArray

mk_assign :: Term -> Term -> Term
mk_assign = mk_op_assign -- FIXME maybe mk_op_assign should be removed. Maybe also the corresponding grammar rules should be dropped

mk_assignable :: Term -> Term
mk_assignable (Lvar i) = Lvasgn i Nothing
mk_assignable (Ivar i) = Ivasgn i Nothing
mk_assignable (Cvar i) = Cvasgn i Nothing
mk_assignable (Gvar i) = Gvasgn i Nothing
mk_assignable (Const parent i) = Casgn parent i Nothing

mk_associate :: [Term] -> Term
mk_associate = Hash

mk_attr_asgn :: Term -> Token -> Token -> Term
mk_attr_asgn receiver t_dot selector_t = call_type_for_dot t_dot receiver (value selector_t ++ "=") []

mk_back_ref, mk_nth_ref :: Token -> Term
mk_back_ref (TBACK_REF s) = BackRef s
mk_nth_ref  (TNTH_REF i)  = NthRef i

mk_begin :: Term -> Term
mk_begin Nil            = Begin []
mk_begin term@(Mlhs _)  = term
--mk_begin term@(Begin _) | (body.loc.begin.nil? && body.loc.end.nil?) = term
mk_begin term           = Begin [term]

mk_begin_body' :: Term -> [Term] -> Term
mk_begin_body' compoundStmt []            = compoundStmt
mk_begin_body' compoundStmt rescue_bodies = Rescue compoundStmt $ rescue_bodies ++ [Nil]

mk_begin_body :: Term -> [Term] -> Term -> Term -> Term
mk_begin_body Nil [] els ensure                     = wrap_in_ensure [] els ensure
mk_begin_body (Begin terms) [] els ensure           = wrap_in_ensure terms els ensure
mk_begin_body compoundStmt [] els ensure            = wrap_in_ensure [compoundStmt] els ensure
mk_begin_body compoundStmt rescue_bodies els ensure = Ensure (Rescue compoundStmt $ rescue_bodies ++ [els]) ensure

wrap_in_ensure terms els ensure = Ensure (Begin $ terms ++ [Begin [els]]) ensure

mk_begin_keyword :: Term -> Term
mk_begin_keyword Nil        = KWBegin []
mk_begin_keyword (Begin ts) = KWBegin ts
mk_begin_keyword t          = KWBegin [t]

mk_binary_op :: Term -> String -> Term -> Term
mk_binary_op receiver "&&" arg = And receiver arg
mk_binary_op receiver "||" arg = Or receiver arg
mk_binary_op receiver op arg = Send receiver op [arg]

mk_block = error "mk_block"

mk_block_pass :: Term -> Term
mk_block_pass = BlockPass

mk_blockarg :: Token -> Term
mk_blockarg = BlockArg . value

mk_call_lambda :: Term
mk_call_lambda = Lambda

mk_call_method :: Term -> Token -> Token -> [Term] -> Term
mk_call_method receiver t_dot selector args = call_type_for_dot t_dot receiver (mk_selector selector) args

mk_case :: Term -> [Term] -> Term
mk_case expr bodies = Case $ expr : bodies

mk_character :: Token -> Term
mk_character (TCHARACTER c)  = Str [c]

mk_complex = error "mk_complex"

mk_condition :: Term -> Term -> Term -> Term
mk_condition = If . check_condition

check_condition :: Term -> Term
check_condition (Begin [term])    = Begin [check_condition term]
check_condition (And lhs rhs)     = And (check_condition lhs) (check_condition rhs)
check_condition (Or lhs rhs)      = Or (check_condition lhs) (check_condition rhs)
--check_condition (Regexp)        =
check_condition condition         = condition

mk_condition_mod :: Term -> Term -> Term -> Term
mk_condition_mod ifTrue ifFalse cond = If (check_condition cond) ifTrue ifFalse

mk_const_fetch :: Term -> Token -> Term
mk_const_fetch first (TCONSTANT second) = Const first second

mk_const_global :: Token -> Term
mk_const_global = Const Cbase . value

mk_const_op_assignable :: Term -> Term
mk_const_op_assignable (Const parent i) = Casgn parent i Nothing

mk_cvar, mk_gvar, mk_ivar, mk_const, mk_ident :: Token -> Term
mk_cvar (TCVAR i)        = Cvar i
mk_gvar (TGVAR i)        = Gvar i
mk_ivar (TIVAR i)        = Ivar i
mk_const (TCONSTANT i)   = Const Nil i
mk_ident (TIDENTIFIER i) = Lvar i

mk_def_class = error "mk_def_class"
mk_def_module = error "mk_def_module"
mk_def_sclass = error "mk_def_sclass"

mk_def_singleton :: Term -> Token -> args -> body -> Term
mk_def_singleton singleton fname args body = Defs singleton (value fname) (Args []) Nil

mk_def_method :: Token -> args -> body -> Term
mk_def_method fname args body = Def (value fname) (Args []) Nil

mk_float :: Token -> Term
mk_float (TFLOAT f) = RFloat f

mk_for :: Term -> Term -> Term -> Term
mk_for = For

mk_index :: Term -> [Term] -> Term
mk_index = Index

mk_index_asgn :: Term -> [Term] -> Term
mk_index_asgn = IndexAsgn

mk_integer :: Token -> Term
mk_integer (TINTEGER i) = RInt i

mk_keyword_cmd :: ([Term] -> Term) -> [Term] -> Term
mk_keyword_cmd f args = f args -- TODO check for yield with block

mk_kwarg :: Token -> Term
mk_kwarg = KWArg . value

mk_kwoptarg :: Token -> Term -> Term
mk_kwoptarg token term = KWOptArg (value token) term

mk_kwrestarg :: Maybe Token -> Term
mk_kwrestarg = KWRestArg . fmap value

mk_kwsplat :: Term -> Term
mk_kwsplat = KWSplat

mk_loop :: (Term -> Term -> Term) -> Term -> Term -> Term
mk_loop = id

mk_loop_mod :: Term -> Token -> Term -> Term
mk_loop_mod body@(KWBegin _) KWHILE cond = WhilePost (check_condition cond) body
mk_loop_mod body@(KWBegin _) KUNTIL cond = UntilPost (check_condition cond) body
mk_loop_mod body             KWHILE cond = While (check_condition cond) body
mk_loop_mod body             KUNTIL cond = Until (check_condition cond) body

mk_match_op = error "mk_match_op"

mk_multi_lhs :: [Term] -> Term
mk_multi_lhs = Mlhs

mk_not_op :: Term -> Term
mk_not_op Nil   = Send (Begin []) "!" []
mk_not_op expr  = Send (check_condition expr) "!" []

mk_op_assign :: Term -> Term -> Term
mk_op_assign (Lvasgn i Nothing) val = lvasgn i val
mk_op_assign (Ivasgn i Nothing) val = ivasgn i val
mk_op_assign (Cvasgn i Nothing) val = cvasgn i val
mk_op_assign (Gvasgn i Nothing) val = gvasgn i val
mk_op_assign (Casgn i parent Nothing) val = casgn i parent val
mk_op_assign t1 t2 = error ("mk_op_assign" ++ show t1 ++ " " ++ show t2)

mk_optarg :: Token -> Term -> Term
mk_optarg token val = OptArg (value token) val

mk_pair :: Term -> Term -> Term
mk_pair = Pair

mk_pair_keyword :: Token -> Term -> Term
mk_pair_keyword token = Pair (Sym $ value token)

mk_pair_quoted = error "mk_pair_quoted"

mk_preexe :: Term -> Term
mk_preexe = Preexe

mk_range_exclusive :: Term -> Term -> Term
mk_range_exclusive = ERange

mk_range_inclusive :: Term -> Term -> Term
mk_range_inclusive = IRange

mk_rational = error "mk_rational"
mk_regexp_compose = error "mk_regexp_compose"
mk_regexp_options = error "mk_regexp_options"

mk_rescue_body :: Term -> Term -> Term -> Term
mk_rescue_body = Resbody

mk_restarg :: Maybe Token -> Term
mk_restarg = RestArg . fmap value

mk_shadowarg :: Token -> Term
mk_shadowarg = ShadowArg . value

mk_splat :: Term -> Term
mk_splat Nil  = Splat Nothing
mk_splat term = Splat . Just $ term

mk_string_compose :: [Term] -> Term
mk_string_compose [t]   = t
mk_string_compose ts    = Dstr ts

mk_string, mk_string_internal :: Token -> Term
mk_string = mk_string_internal
mk_string_internal (TSTRING s) = Str s

mk_symbol_compose :: [Term] -> Term
mk_symbol_compose = error "mk_symbol_compose"

mk_symbol, mk_symbol_internal :: Token -> Term
mk_symbol = mk_symbol_internal
mk_symbol_internal (TSYMBOL s) = Sym s
mk_symbol_internal (TIDENTIFIER s) = Sym s

mk_symbols_compose = error "mk_symbols_compose"

mk_ternary :: Term -> Term -> Term -> Term
mk_ternary = mk_condition

mk_unary_num = error "mk_unary_num"

mk_unary_op :: String -> Term -> Term
mk_unary_op op receiver = Send receiver op []

mk_undef_method :: [Term] -> Term
mk_undef_method = Undef

mk_when :: [Term] -> Term -> Term
mk_when cases body = When $ cases ++ [body]

mk_word = error "mk_word"
mk_words_compose = error "mk_words_compose"
mk_xstring_compose = error "mk_xstring_compose"

-- mk_block' (begin_t, args, body, end_t) = mk_block (mk_call_method $1 $2 $3 $4) begin_t Args body end_t
mk_block' = error "mk_block"

--- private

call_type_for_dot :: Token -> (Term -> String -> [Term] -> Term)
call_type_for_dot TANDDOT = Csend
call_type_for_dot _ = Send

value :: Token -> String
value (TIDENTIFIER i) = i
value (TCONSTANT i)   = i
value other           = error (show other)

mk_selector :: Token -> String
mk_selector KNIL = "call"
mk_selector s   = value s

arg_name :: Term -> String
arg_name (Arg name)              = name
arg_name (OptArg name _)         = name
arg_name (RestArg (Just name))   = name
arg_name (RestArg Nothing)       = "*"
arg_name (BlockArg name)         = name
arg_name (KWArg name)            = name
arg_name (KWOptArg name _)       = name
arg_name (KWRestArg (Just name)) = name
arg_name (KWRestArg Nothing)     = "*"
arg_name (ShadowArg name)        = name


{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedLabels    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE CPP #-}

module Grenade.Onnx.Utils
  ( hasType
  , loadFailure
  , loadFailureReason
  , loadFailureAttr
  , loadFailureExpecting
  , guardOnnx
  , guardAttr
  , readInitializerMatrix
  , readInitializerVector
  , readInitializerTensorIntoMatrix
  , readInitializerTensorIntoVector
  , readIntAttribute
  , filterIntAttribute
  , readIntsAttribute
  , filterIntsAttribute
  , readFloatAttributeToRealNum
  , filterRealNumAttribute
  , doesNotHaveAttribute
  , hasSupportedGroup
  , hasSupportedDilations
  , hasMatchingShape
  , hasMatchingInt
  , hasMatchingRealNum
  , hasCorrectPadding
  , onnxIncorrectNumberOfInputs
  ) where

import           Control.Monad                (void)
import qualified Data.ByteString.Internal     as BS
import qualified Data.Vector.Storable         as V
import           Data.Either.Combinators
import           Data.List                    (find)
import qualified Data.Map.Strict              as Map
import           Data.Proxy

import           Foreign.ForeignPtr

import           Grenade.Onnx.OnnxLoadFailure
import           Grenade.Onnx.OnnxOperator

import           Numeric.LinearAlgebra        hiding (R, find, (<>))
import           Numeric.LinearAlgebra.Static (L, R)
import qualified Numeric.LinearAlgebra.Static as H

#if USE_FLOAT
#else
import           Data.Word                    (Word32)
import           GHC.Float                    (castWord32ToFloat, float2Double)
#endif
import           GHC.TypeLits

import           Data.ProtoLens.Labels        ()
import qualified Data.Text                    as T
import           Lens.Micro                   ((^.))
import qualified Proto.Onnx                   as P

import           Grenade.Types

hasType :: forall a. OnnxOperator a => P.NodeProto -> Proxy a -> Either OnnxLoadFailure ()
hasType node a
  | node ^. #opType `elem` expectedTypes = return ()
  | otherwise = void loadFail
  where
    nodeType = node ^. #opType
    expectedTypes = onnxOpTypeNames a
    loadFail :: Either OnnxLoadFailure (a, b, c)
    loadFail = loadFailureExpecting ("Unexpected node type: " ++ show nodeType) (Just node)

loadFailure :: String -> Maybe P.NodeProto -> Maybe P.NodeProto -> [String] -> Either OnnxLoadFailure a
loadFailure reason last curr types = Left (OnnxLoadFailure reason last curr types)

loadFailureReason :: String -> Either OnnxLoadFailure a
loadFailureReason reason = Left (OnnxLoadFailure reason Nothing Nothing [])

loadFailureAttr :: String -> P.NodeProto -> Either OnnxLoadFailure a
loadFailureAttr reason curr = loadFailure reason Nothing (Just curr) []

loadFailureExpecting :: forall a b c. OnnxOperator a => String -> Maybe P.NodeProto -> Either OnnxLoadFailure (a, b, c)
loadFailureExpecting reason curr = loadFailure reason Nothing curr (show <$> onnxOpTypeNames (Proxy :: Proxy a))

guardOnnx :: String -> Bool -> Either OnnxLoadFailure ()
guardOnnx reason cond
  | cond = return ()
  | otherwise = loadFailureReason reason

guardAttr :: T.Text -> Bool -> Either OnnxLoadFailure ()
guardAttr attribute = guardOnnx ("Attribute '" ++ show attribute ++ "' did not pass predicate")

maybeLoadFailureReason :: String -> Maybe a -> Either OnnxLoadFailure a
maybeLoadFailureReason reason = maybe (loadFailureReason reason) Right

readAttribute :: T.Text -> P.NodeProto -> Either OnnxLoadFailure P.AttributeProto
readAttribute attribute node = maybeLoadFailureReason ("Attribute '" ++ show attribute ++ "' was not found")
                                 (find ((== attribute) . (^. #name)) (node ^. #attribute))

readIntAttribute :: T.Text -> P.NodeProto -> Either OnnxLoadFailure Int
readIntAttribute attributeName node = readAttribute attributeName node >>= retrieve
  where
    retrieve attribute =
      case attribute ^. #type' of
        P.AttributeProto'INT -> Right $ fromIntegral $ attribute ^. #i
        _                    -> loadFailureReason $ "Type of attribute '" ++ show attributeName ++ "' is not int"

filterIntAttribute :: T.Text -> (Int -> Bool) -> P.NodeProto -> Either OnnxLoadFailure ()
filterIntAttribute attribute pred node = readIntAttribute attribute node >>= guardAttr attribute . pred

readFloatAttributeToRealNum :: T.Text -> P.NodeProto -> Either OnnxLoadFailure RealNum
readFloatAttributeToRealNum attributeName node = readAttribute attributeName node >>= retrieve
  where
    retrieve attribute = case (attribute ^. #type') of
#if USE_FLOAT
                           P.AttributeProto'FLOAT -> Right $ attribute ^. #f
#else
                           P.AttributeProto'FLOAT -> Right . float2Double $ attribute ^. #f
#endif
                           _                      -> loadFailureReason $
                                                       "Type of attribute '" ++ show attributeName ++ "' is not float"

filterRealNumAttribute :: T.Text -> (RealNum -> Bool) -> P.NodeProto -> Either OnnxLoadFailure ()
filterRealNumAttribute attribute pred node = readFloatAttributeToRealNum attribute node >>= guardAttr attribute . pred

readIntsAttribute :: T.Text -> P.NodeProto -> Either OnnxLoadFailure [Int]
readIntsAttribute attributeName node = readAttribute attributeName node >>= retrieve
  where
    retrieve attribute = case (attribute ^. #type') of
                           P.AttributeProto'INTS -> Right . map fromIntegral $ attribute ^. #ints
                           _                     -> loadFailureReason $
                                                      "Type of attribute '" ++ show attributeName ++ "' is not ints"

filterIntsAttribute :: T.Text -> ([Int] -> Bool) -> P.NodeProto -> Either OnnxLoadFailure ()
filterIntsAttribute attribute pred node = readIntsAttribute attribute node >>= guardAttr attribute . pred

doesNotHaveAttribute :: P.NodeProto -> T.Text -> Either OnnxLoadFailure ()
doesNotHaveAttribute node attribute = guardAttr attribute $ isLeft $ readAttribute attribute node

readInitializer :: Map.Map T.Text P.TensorProto -> T.Text -> Either OnnxLoadFailure ([Int], Vector RealNum)
readInitializer inits name = maybeLoadFailureReason ("Initializer '" ++ show name ++ "' does not exist")
                               (Map.lookup name inits) >>= retrieve
  where
    rawDataToVector :: P.TensorProto-> Maybe (Vector RealNum)
    rawDataToVector tensor
      = let (ptr, off, len)    = BS.toForeignPtr (tensor ^. #rawData)
            vec                = V.unsafeFromForeignPtr (castForeignPtr ptr) (div off 4) (div len 4)
#if USE_FLOAT
        in  if len == 0 then Nothing else Just vec
#else
        in if len == 0 then Nothing else Just $ V.map (float2Double . castWord32ToFloat) vec
#endif

    readFloatData :: P.TensorProto -> Either OnnxLoadFailure (Vector RealNum)
    readFloatData tensor
      = let floatData = tensor ^. #floatData
        in  if null floatData then loadFailureReason ("Failed reading raw_data field of initializer " ++ show name)
#if USE_FLOAT
                              else Right $ vector floatData
#else
                              else Right $ vector $ map float2Double floatData
#endif

    getData :: P.TensorProto -> Either OnnxLoadFailure (Vector RealNum)
    getData tensor = case rawDataToVector tensor of
      Just vec -> Right vec
      Nothing   -> readFloatData tensor

    retrieve tensor = let vec = getData tensor
                      in  case toEnum (fromIntegral (tensor ^. #dataType)) of
                            P.TensorProto'FLOAT -> (map fromIntegral $ tensor ^. #dims, ) <$> vec
                            _                   -> loadFailureReason $ "Type of attribute '" ++ show name ++ "' is not float"

readInitializerMatrix :: (KnownNat r, KnownNat c) => Map.Map T.Text P.TensorProto -> T.Text -> Either OnnxLoadFailure (L r c)
readInitializerMatrix inits name = do
  initializer <- readInitializer inits name
  maybeLoadFailureReason ("Failed to read initializer '" ++ show name ++ "' as matrix") (readMatrix initializer)

readInitializerTensorIntoMatrix :: (KnownNat r, KnownNat c) => Map.Map T.Text P.TensorProto -> T.Text -> Either OnnxLoadFailure (L r c)
readInitializerTensorIntoMatrix inits name = do
  initializer <- readInitializer inits name
  maybeLoadFailureReason ("Failed to read initializer tensor '" ++ show name ++ "' as matrix") (readTensorIntoMatrix initializer)

readInitializerTensorIntoVector :: (KnownNat c) => Map.Map T.Text P.TensorProto -> T.Text -> Either OnnxLoadFailure (R c)
readInitializerTensorIntoVector inits name = do
  initializer <- readInitializer inits name
  maybeLoadFailureReason ("Failed to read initializer tensor '" ++ show name ++ "' as matrix into vector") (readMatrixToVector initializer)

readInitializerVector :: KnownNat r => Map.Map T.Text P.TensorProto -> T.Text -> Either OnnxLoadFailure (R r)
readInitializerVector inits name = do
  initializer <- readInitializer inits name
  maybeLoadFailureReason ("Failed to read initializer '" ++ show name ++ "' as vector") (readVector initializer)

vector' :: forall r . (KnownNat r) => Vector RealNum -> Maybe (R r)
vector' = H.create
{-# INLINE vector' #-}

matrix' :: forall r c . (KnownNat r, KnownNat c) => Vector RealNum -> Maybe (L r c)
matrix' vec = let cols = fromIntegral $ natVal (Proxy :: Proxy c) in H.create $ reshape cols vec
{-# INLINE matrix' #-}

readMatrix :: forall r c . (KnownNat r, KnownNat c) => ([Int], Vector RealNum) -> Maybe (L r c)
readMatrix ([rows, cols], vals)
  | neededRows == rows && neededCols == cols = matrix' vals
  where
    neededRows = fromIntegral $ natVal (Proxy :: Proxy r)
    neededCols = fromIntegral $ natVal (Proxy :: Proxy c)
readMatrix _ = Nothing

readTensorIntoMatrix :: forall r c . (KnownNat r, KnownNat c) => ([Int], Vector RealNum) -> Maybe (L r c)
readTensorIntoMatrix (rows : cols, vals)
  | neededRows == rows && neededCols == product cols = matrix' vals
  where
    neededRows = fromIntegral $ natVal (Proxy :: Proxy r)
    neededCols = fromIntegral $ natVal (Proxy :: Proxy c)
readTensorIntoMatrix _ = Nothing

readVector :: forall r . KnownNat r => ([Int], Vector RealNum) -> Maybe (R r)
readVector ([rows], vals)
  | rows == neededRows = vector' vals
  where
    neededRows = fromIntegral $ natVal (Proxy :: Proxy r)
readVector _ = Nothing

readMatrixToVector :: forall r . KnownNat r => ([Int], Vector RealNum) -> Maybe (R r)
readMatrixToVector (dims, vals)
  | product dims == neededRows = vector' vals
  where
    neededRows = fromIntegral $ natVal (Proxy :: Proxy r)
readMatrixToVector _ = Nothing

hasSupportedGroup :: P.NodeProto -> Either OnnxLoadFailure ()
hasSupportedGroup node = (node `doesNotHaveAttribute` "group")
                      <> (filterIntAttribute "group" (== 1) node)

hasSupportedDilations :: P.NodeProto -> Either OnnxLoadFailure ()
hasSupportedDilations node = (node `doesNotHaveAttribute` "dilations")
                          <> (filterIntsAttribute "dilations" (all (==1)) node)

hasMatchingShape :: P.NodeProto -> T.Text -> [Integer] -> Either OnnxLoadFailure ()
hasMatchingShape node attribute dims = filterIntsAttribute attribute (== map fromIntegral dims) node

hasCorrectPadding :: (KnownNat padLeft, KnownNat padRight, KnownNat padTop, KnownNat padBottom)
                  => P.NodeProto -> Proxy padLeft -> Proxy padRight -> Proxy padTop -> Proxy padBottom -> Either OnnxLoadFailure ()
hasCorrectPadding node ppl ppr ppt ppb
  = let left   = fromIntegral $ natVal ppl
        right  = fromIntegral $ natVal ppr
        top    = fromIntegral $ natVal ppt
        bottom = fromIntegral $ natVal ppb
        paddings = case readIntsAttribute "pads" node of
                     Right ps -> ps
                     Left  _  -> [0, 0, 0, 0]
     in case paddings of
          [left', top', right', bottom'] -> guardOnnx "Padding dimensions mismatch" (left == left' && top == top' && right == right' && bottom == bottom')
          _                              -> loadFailureReason "Incorrect padding dimensions"

hasMatchingRealNum :: KnownSymbol a => P.NodeProto -> Proxy a -> T.Text -> Either OnnxLoadFailure ()
hasMatchingRealNum node a x = do
  let a' = (read $ symbolVal a) :: RealNum
  x' <- readFloatAttributeToRealNum x node
#if USE_FLOAT
  guardOnnx ("Value mismatch for attribute " ++ T.unpack x ++ " of type float") (x' == a')
#else
  guardOnnx ("Value mismatch for attribute " ++ T.unpack x ++ " of type double") (x' == a')
#endif

hasMatchingInt :: KnownNat a => P.NodeProto -> Proxy a -> T.Text -> Either OnnxLoadFailure ()
hasMatchingInt node a x = do
  let a' = fromIntegral $ natVal a
  x' <- readIntAttribute x node
  guardOnnx ("Value mismatch for attribute " ++ T.unpack x ++ " of type int") (x' == a')

onnxIncorrectNumberOfInputs :: Either OnnxLoadFailure a
onnxIncorrectNumberOfInputs = loadFailureReason "Incorrect number of inputs"