content: 
  module DDC.Core.Flow.Transform.Slurp.Resize
      ( Resize(..)
      , slurpResize
      , lookupOrDie
      , seqEitherMaybe )
  where
  import DDC.Core.Flow.Transform.Slurp.Error
  import DDC.Core.Flow.Prim
  import DDC.Core.Flow.Exp.Simple.Compounds
  import DDC.Core.Flow.Exp.Simple.Exp
  import qualified Data.Map               as Map
  
  type Ty = Type Name
  
  data Resize
   = Id    Ty
   | AppL  Ty Ty
   | AppR  Ty Ty
   | App   Ty Ty Ty Ty Resize Resize 
   | Sel1  Ty Ty Ty      Resize
   | Segd  Ty Ty Ty      Resize
   | Cross Ty Ty Ty      Resize
   deriving Show
  
  slurpResize
      :: Map.Map Name Resize
      -> Exp ()  Name
      -> Either Error (Maybe Resize)
  
  slurpResize rs xx
  
   | Just ( NameOpSeries OpSeriesResizeId
          , [ _, tK ] )
                  <- takeXPrimApps xx
   = return (Id <$> nameOfType tK)
  
   | Just ( NameOpSeries OpSeriesResizeAppL
          , [ _, tK, tL ] )
                  <- takeXPrimApps xx
   = return (AppL <$> nameOfType tK <*> nameOfType tL)
  
   | Just ( NameOpSeries OpSeriesResizeAppR
          , [ _, tK, tL ] )
                  <- takeXPrimApps xx
   = return (AppR         <$> nameOfType tK <*> nameOfType tL)
  
   | Just ( NameOpSeries OpSeriesResizeApp
          , [ _, tK, tK', tL, tL'
            , XVar (UName rL)
            , XVar (UName rR) ] )
                  <- takeXPrimApps xx
   = do   rL'     <- lookupOrDie rL rs
          rR'     <- lookupOrDie rR rs
          return (App     <$> nameOfType tK <*> nameOfType tK'
                          <*> nameOfType tL <*> nameOfType tL'
                          <*> Just rL'      <*> Just rR')
  
   | Just ( NameOpSeries OpSeriesResizeSel1
          , [ _, tJ, tK, tL
            , _
            , XVar (UName r) ] )
                  <- takeXPrimApps xx
   = do   r'      <- lookupOrDie r rs
          return (Sel1    <$> nameOfType tJ <*> nameOfType tK
                          <*> nameOfType tL
                          <*> Just r')
  
   | Just ( NameOpSeries OpSeriesResizeSegd
          , [ _, tJ, tK, tL
            , _
            , XVar (UName r) ] )
                  <- takeXPrimApps xx
   = do   r'      <- lookupOrDie r rs
          return (Segd    <$> nameOfType tJ <*> nameOfType tK
                          <*> nameOfType tL
                          <*> Just r')
  
  
   | Just ( NameOpSeries OpSeriesResizeCross
          , [ _, tJ, tK, tL
            , _
            , XVar (UName r) ] )
                  <- takeXPrimApps xx
   = do   r'      <- lookupOrDie r rs
          return (Cross   <$> nameOfType tJ <*> nameOfType tK
                          <*> nameOfType tL
                          <*> Just r')
  
  
  
   | otherwise
   = return Nothing
  
  
  nameOfType :: Exp () Name -> Maybe (Type Name)
  
  nameOfType (XType t)
   = Just t
  
  nameOfType _
   = Nothing
  
  
  lookupOrDie
      :: Name
      -> Map.Map Name v
      -> Either Error v
  lookupOrDie n m
   = case Map.lookup n m of
      Just v  -> return v
      Nothing -> Left $ ErrorNotInContext n
  
  seqEitherMaybe :: Either a (Maybe b) -> Maybe (Either a b)
  seqEitherMaybe x
   = case x of
     Left a         -> Just (Left a)
     Right Nothing  -> Nothing
     Right (Just b) -> Just (Right b)
  
  