{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-incomplete-record-updates #-} -- tupleBoxCoord
{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}

module Handler.Utils.Form.MassInput
  ( MassInput(..), MassInputLayout, MassInputDelete
  , defaultMiLayout, listMiLayout
  , massInput
  , module Handler.Utils.Form.MassInput.Liveliness
  , massInputA, massInputW
  , massInputList, massInputListA
  , massInputAccum, massInputAccumA, massInputAccumW
  , massInputAccumEdit, massInputAccumEditA, massInputAccumEditW
  , ListLength(..), ListPosition(..), miDeleteList
  , EnumLiveliness(..), EnumPosition(..)
  , MapLiveliness(..)
  ) where

import Import
import Utils.Form
import Handler.Utils.Form.MassInput.Liveliness
import Handler.Utils.Form.MassInput.TH

import Text.Blaze (Markup)

import qualified Data.Text as Text

import qualified Data.Set as Set
import qualified Data.IntSet as IntSet
import Data.Map ((!))
import qualified Data.Map as Map
import qualified Data.Foldable as Fold

import Control.Monad.Reader.Class (MonadReader(local))

import Text.Hamlet (hamletFile)

import Algebra.Lattice.Ordered (Ordered(..))


$(mapM tupleBoxCoord [2..4])


newtype ListLength = ListLength { unListLength :: Natural }
  deriving newtype (Num, Integral, Real, Enum, PathPiece)
  deriving (Eq, Ord, Generic, Typeable, Read, Show)

makeWrapped ''ListLength

deriving via Ordered ListLength instance Lattice ListLength

instance BoundedJoinSemiLattice ListLength where
  bottom = 0

newtype ListPosition = ListPosition { unListPosition :: Natural }
  deriving newtype (Num, Integral, Real, Enum, PathPiece, ToJSON, FromJSON, ToJSONKey, FromJSONKey)
  deriving (Eq, Ord, Generic, Typeable, Read, Show)

makeWrapped ''ListPosition

instance IsBoxCoord ListPosition where
  boxDimensions = [BoxDimension _Wrapped]
  boxOrigin = 0

instance Liveliness ListLength where
  type BoxCoord ListLength = ListPosition
  liveCoords = prism' toSet fromSet
    where
      toSet n
        | n > 0     = Set.fromList [0..pred (fromIntegral n)]
        | otherwise = Set.empty

      fromSet ns
        | ns == maybe Set.empty (\n -> Set.fromList [0..n]) max'
        = fmap (succ . fromIntegral) max' <|> Just 0
        | otherwise
        = Nothing
        where
          max' = Set.lookupMax ns
  liveCoord (ListPosition n) = prism' (\(ListLength l) -> n < l) (bool (Just bottom) (1 <$ guard (n == 0)))


newtype EnumLiveliness enum = EnumLiveliness { unEnumLiveliness :: IntSet }
  deriving (Eq, Ord, Generic, Typeable, Read, Show)

makeWrapped ''EnumLiveliness

instance Lattice (EnumLiveliness enum) where
  (EnumLiveliness a) \/ (EnumLiveliness b) = EnumLiveliness $ a `IntSet.union` b
  (EnumLiveliness a) /\ (EnumLiveliness b) = EnumLiveliness $ a `IntSet.intersection` b
instance BoundedJoinSemiLattice (EnumLiveliness enum) where
  bottom = EnumLiveliness IntSet.empty
instance (Enum enum, Bounded enum) => BoundedMeetSemiLattice (EnumLiveliness enum) where
  top = EnumLiveliness . IntSet.fromList $ map (fromEnum :: enum -> Int) [minBound..maxBound]


newtype EnumPosition enum = EnumPosition { unEnumPosition :: enum }
  deriving newtype (Enum, Bounded, PathPiece, ToJSON, FromJSON, ToJSONKey, FromJSONKey)
  deriving (Eq, Ord, Generic, Typeable, Read, Show)

makeWrapped ''EnumPosition

instance (Enum enum, Bounded enum, PathPiece enum, ToJSON enum, FromJSON enum, ToJSONKey enum, FromJSONKey enum, Eq enum, Ord enum) => IsBoxCoord (EnumPosition enum) where
  boxDimensions = [BoxDimension _Wrapped]
  boxOrigin = minBound

instance (Enum enum, Bounded enum, PathPiece enum, ToJSON enum, FromJSON enum, ToJSONKey enum, FromJSONKey enum, Eq enum, Ord enum) => Liveliness (EnumLiveliness enum) where
  type BoxCoord (EnumLiveliness enum) = EnumPosition enum
  liveCoords = iso fromSet toSet
    where
      toSet :: EnumLiveliness enum -> Set (EnumPosition enum)
      toSet = Set.fromList . map toEnum . IntSet.toList . unEnumLiveliness
      fromSet :: Set (EnumPosition enum) -> EnumLiveliness enum
      fromSet = EnumLiveliness . IntSet.fromList . map fromEnum . Set.toList


newtype MapLiveliness l1 l2 = MapLiveliness { unMapLiveliness :: Map (BoxCoord l1) l2 }
  deriving (Generic, Typeable)

makeWrapped ''MapLiveliness

deriving instance (Ord (BoxCoord l1), Lattice l2) => Lattice (MapLiveliness l1 l2)
deriving instance (Ord (BoxCoord l1), BoundedJoinSemiLattice l2) => BoundedJoinSemiLattice (MapLiveliness l1 l2)
deriving instance (Ord (BoxCoord l1), Finite (BoxCoord l1), BoundedMeetSemiLattice l2) => BoundedMeetSemiLattice (MapLiveliness l1 l2)
deriving instance (Eq (BoxCoord l1), Eq l2) => Eq (MapLiveliness l1 l2)
deriving instance (Ord (BoxCoord l1), Ord l2) => Ord (MapLiveliness l1 l2)
deriving instance (Ord (BoxCoord l1), Read (BoxCoord l1), Read l2) => Read (MapLiveliness l1 l2)
deriving instance (Show (BoxCoord l1), Show l2) => Show (MapLiveliness l1 l2)

instance (Liveliness l1, Liveliness l2) => Liveliness (MapLiveliness l1 l2) where
  type BoxCoord (MapLiveliness l1 l2) = (BoxCoord l1, BoxCoord l2)
  liveCoords = prism'
    (Set.fromList . concatMap (\(k, v) -> (k, ) <$> Set.toAscList (review liveCoords v)) . Map.toAscList . unMapLiveliness)
    (\ts -> let ks = Set.mapMonotonic fst ts in fmap MapLiveliness . sequence $ Map.fromSet (\k -> preview liveCoords . Set.mapMonotonic snd $ Set.filter ((== k) . fst) ts) ks)


type MassInputDelete liveliness = forall m a. Applicative m => Map (BoxCoord liveliness) a -> (BoxCoord liveliness) -> m (Map (BoxCoord liveliness) (BoxCoord liveliness))


miDeleteList :: MassInputDelete ListLength
miDeleteList dat pos
    -- Close gap left by deleted position with values from further down the list; try prohibiting certain deletions by utilising `guard`
  | Just l <- preview liveCoords $ Map.keysSet dat :: Maybe ListLength
  , l >= 2 = pure . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
  | otherwise = pure Map.empty

data ButtonMassInput coord
  = MassInputAddDimension Natural coord
  | MassInputDeleteCell coord
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance PathPiece coord => PathPiece (ButtonMassInput coord) where
  toPathPiece = \case
    MassInputAddDimension n c -> "add__" <> toPathPiece n <> "__" <> toPathPiece c
    MassInputDeleteCell c -> "delete__" <> toPathPiece c
  fromPathPiece t = addDim <|> delCell
    where
      addDim = do
        (dimT, Text.stripPrefix "__" -> Just coordT) <- Text.breakOn "__" <$> stripPrefix "add__" t
        MassInputAddDimension <$> fromPathPiece dimT <*> fromPathPiece coordT
      delCell = do
        coordT <- stripPrefix "delete__" t
        MassInputDeleteCell <$> fromPathPiece coordT

instance RenderMessage UniWorX (ButtonMassInput coord) where
  renderMessage f ls = \case
    MassInputAddDimension _ _ -> mr MsgMassInputAddDimension
    MassInputDeleteCell _ -> mr MsgMassInputDeleteCell
    where
      mr = renderMessage f ls

instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
  btnValidate _ _ = False

  btnClasses (MassInputAddDimension _ _) = [BCIsButton, BCDefault, BCMassInputAdd]
  btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning, BCMassInputDelete]


data MassInputFieldName coord
  = MassInputShape { miName :: Text }
  | MassInputAddWidget { miName :: Text, miCoord :: coord, miAddWidgetField :: Text }
  | MassInputAddButton { miName :: Text, miCoord :: coord }
  | MassInputDeleteButton { miName :: Text, miCoord :: coord }
  | MassInputCell { miName :: Text, miCoord :: coord, miCellField :: Text }
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
  toPathPiece = \case
    MassInputShape{..} -> [st|#{miName}__shape|]
    MassInputAddWidget{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__fields__#{miAddWidgetField}|]
    MassInputAddButton{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__submit|]
    MassInputDeleteButton{..} -> [st|#{miName}__delete__#{toPathPiece miCoord}|]
    MassInputCell{..} -> [st|#{miName}__cells__#{toPathPiece miCoord}__#{miCellField}|]

  fromPathPiece t = do
    (miName, Text.stripPrefix "__" -> Just t') <- return $ Text.breakOn "__" t
    choice
      [ do
          guard $ t' == "shape"
          return MassInputShape{..}
      , do
          t'' <- Text.stripPrefix "add__" t'
          (coordT, Text.stripPrefix "__" -> Just rest) <- return $ Text.breakOn "__" t''
          miAddWidgetField <- Text.stripPrefix "fields__" rest
          miCoord <- fromPathPiece coordT
          return MassInputAddWidget{..}
      , do
          t'' <- Text.stripPrefix "add__" t'
          (coordT, Text.stripPrefix "__" -> Just ident) <- return $ Text.breakOn "__" t''
          guard $ ident == "submit"
          miCoord <- fromPathPiece coordT
          return MassInputAddButton{..}
      , do
          t'' <- Text.stripPrefix "delete__" t'
          (coordT, rest) <- return $ Text.breakOn "__" t''
          guard $ Text.null rest
          miCoord <- fromPathPiece coordT
          return MassInputDeleteButton{..}
      , do
          t'' <- Text.stripPrefix "cells__" t'
          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t''
          miCoord <- fromPathPiece coordT
          return MassInputCell{..}
      ]

data MassInputException = MassInputInvalidShape
  deriving (Eq, Ord, Read, Show, Generic, Typeable)

instance Exception MassInputException

data MassInput handler liveliness cellData cellResult = forall i. PathPiece i => MassInput
  { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero)
          -> Natural -- Zero-based dimension index @dimIx@
          -> (Text -> Text) -- Nudge deterministic field ids
          -> FieldView UniWorX -- Submit button
          -> Maybe (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData)), Widget)) -- ^ Construct a Cell-Addition Widget
  , miCell :: BoxCoord liveliness -- Position
           -> cellData -- @cellData@ from @miAdd@
           -> Maybe cellResult -- Initial result from Argument to @massInput@
           -> (Text -> Text) -- Nudge deterministic field ids
           -> (Markup -> MForm handler (FormResult cellResult, Widget)) -- ^ Construct a singular cell
  , miDelete :: Map (BoxCoord liveliness) cellData
             -> BoxCoord liveliness
             -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness)) -- ^ Decide whether a deletion-operation should be permitted and produce a finite map of new coordinates to their old correspondants
  , miAllowAdd :: BoxCoord liveliness
               -> Natural
               -> liveliness
               -> Bool -- ^ Decide whether an addition-operation should be permitted
  , miAddEmpty :: BoxCoord liveliness
               -> Natural
               -> liveliness
               -> Set (BoxCoord liveliness) -- ^ Usually addition widgets are only provided for dimension 0 and all _lines_ that have at least one live coordinate. `miAddEmpty` allows specifying when to provide additional widgets
  , miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX) -- ^ Override form-tag route for `massInput`-Buttons to keep the user closer to the Widget, the `PathPiece` Argument is to be used for constructiong a `Fragment`
  , miLayout :: MassInputLayout liveliness cellData cellResult
  , miIdent :: i
  }

type MassInputLayout liveliness cellData cellResult
  =    liveliness
    -> Map (BoxCoord liveliness) (cellData, FormResult cellResult)
    -> Map (BoxCoord liveliness) Widget -- Cell Widgets
    -> Map (BoxCoord liveliness) (FieldView UniWorX) -- Delete buttons
    -> Map (Natural, BoxCoord liveliness) Widget -- Addition forms
    -> Widget

-- | Multiple multi-layerd input fields
--   May short-circuit a handler if the frontend only asks for the content, i.e. handler actions after calls to massInput may not happen at all.
massInput :: forall handler cellData cellResult liveliness.
           ( MonadHandler handler, HandlerSite handler ~ UniWorX
           , ToJSON cellData, FromJSON cellData
           , Liveliness liveliness
           , MonadThrow handler
           )
          => MassInput handler liveliness cellData cellResult
          -> FieldSettings UniWorX
          -> Bool -- ^ Required?
          -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
          -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvRequired initialResult csrf = do
  let initialShape = fmap fst <$> initialResult

  miName <- maybe newFormIdent return fsName
  fvId <- maybe newIdent return fsId
  miAction <- traverse toTextUrl $ miButtonAction fvId
  let addFormAction = maybe id (addAttr "formaction") miAction

  let
    shapeName :: MassInputFieldName (BoxCoord liveliness)
    shapeName = MassInputShape{..}
    shapeField :: Field handler (Map (BoxCoord liveliness) cellData)
    shapeField = secretJsonField
  sentShape <- runMaybeT $ do
    ts <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askParams
    fs <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askFiles
    MaybeT $ either (const Nothing) id <$> lift (fieldParse shapeField ts fs)
  sentShape' <- if
    | Just s <- sentShape -> return s
    | Just iS <- initialShape -> return iS
    | Set.null $ review liveCoords (bottom :: liveliness) -> return Map.empty
    | otherwise -> throwM MassInputInvalidShape
  sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness

  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData))), Maybe Widget))
      addForm = addForm' boxOrigin [] . zip [0..]
        where
          addForm' _ _ [] = return Map.empty
          addForm' miCoord pDims (dim''@(dimIx, _) : remDims) = do
            let nudgeAddWidgetName :: Text -> Text
                nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
            (btnRes', btnView) <- mopt (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..} & addFormAction) Nothing
            let btnRes = do
                  Just x <- btnRes'
                  return x
                wBtnRes res = do
                  guard $ isn't _FormMissing btnRes
                  res
                miAdd' = traverse ($ mempty) $ miAdd miCoord dimIx nudgeAddWidgetName btnView
            addRes'' <- miAdd' & mapped . _Just . _1 %~ wBtnRes
            addRes' <- fmap join . for addRes'' $ bool (return . Just) (\(res, _view) -> set (_Just . _1) res <$> local (set _1 Nothing) miAdd') (is (_Just . _FormSuccess) (fst <$> addRes'') || is _FormMissing btnRes)
            let dimRes' = Map.singleton (dimIx, miCoord) (maybe (Nothing <$ btnRes) (fmap Just) $ fmap fst addRes', fmap snd addRes')
            case remDims of
              [] -> return dimRes'
              ((_, BoxDimension dim) : _) -> do
                let miCoords
                      = Set.union (miAddEmpty miCoord dimIx sentLiveliness)
                      . Set.map (\c -> miCoord & dim .~ (c ^. dim))
                      . Set.filter (\c -> and [ ((==) `on` view pDim) miCoord c | (_, BoxDimension pDim) <- pDims `snoc` dim'' ])
                      $ review liveCoords sentLiveliness
                dimRess <- sequence $ Map.fromSet (\c -> addForm' c (pDims `snoc` dim'') remDims) miCoords
                return $ dimRes' `Map.union` fold dimRess

  addResults <- addForm boxDimensions
  let
    addResults' :: Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData)))
    addResults' = flip Map.mapWithKey (fst <$> addResults) $ \(dimIx, miCoord) -> \case
        FormSuccess (Just mkResult)
          | miAllowAdd miCoord dimIx sentLiveliness -> Just <$> mkResult sentShape'
        other -> Nothing <$ other
  let addShape
        | [((dimIx, miCoord), FormSuccess (Just mkResult))] <- Map.toList . Map.filter (is $ _FormSuccess . _Just) $ fmap fst addResults
        = Just $ maybe id Map.union (formResultToMaybe $ mkResult sentShape' <* guard (miAllowAdd miCoord dimIx sentLiveliness)) sentShape'
        | otherwise = Nothing

  addedShape <- if
    | Just s <- addShape -> return s
    | otherwise -> return sentShape'

  let
    delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
    delForm miCoord = do
      (delRes, delView) <- lift $ mopt (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..} & addFormAction) Nothing
      shapeUpdate <- miDelete addedShape miCoord
      guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
      return (shapeUpdate <$ assertM (is _Just) delRes, delView)

  delResults <- fmap (Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
  let
    delShapeUpdate
        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = Just shapeUpdate'
        | otherwise = Nothing
    delShape = traverse (flip Map.lookup addedShape) =<< delShapeUpdate


  let shapeChanged = Fold.any (isn't _FormMissing . view _1) addResults || Fold.any (is _FormSuccess . view _1) delResults

  shape <- if
    | Just s <- addShape -> return s
    | Just s <- delShape -> return s
    | otherwise          -> return sentShape'
  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness

  shapeId <- newIdent
  let shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True


  let
    applyDelShapeUpdate :: Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
    applyDelShapeUpdate prevEnv
      | Just delShapeUpdate' <- delShapeUpdate
      , Just (env, fEnv) <- prevEnv
      = let reverseUpdate = Map.fromList . map swap $ Map.toList delShapeUpdate'
         in Just . (, fEnv) . flip (Map.mapKeysWith mappend) env $ \k -> fromMaybe k $ do
              cell@MassInputCell{miCoord} <- fromPathPiece k
              newCoord <- Map.lookup miCoord reverseUpdate
              return $ toPathPiece cell{ miCoord = newCoord }
      | otherwise = prevEnv

    justAdded :: Set (BoxCoord liveliness)
    justAdded = Map.keysSet shape Set.\\ Map.keysSet sentShape'

    restrictJustAdded :: BoxCoord liveliness -> Maybe a -> Maybe a
    restrictJustAdded miCoord env = env <* guard (not $ Set.member miCoord justAdded)

  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
    let
      nudgeCellName :: Text -> Text
      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
    local (over _1 (applyDelShapeUpdate . restrictJustAdded miCoord)) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
      result = do
        FormSuccess () <|> void (asum $ Map.elems addResults')
        FormSuccess () <|> void (asum . Map.elems $ fst <$> delResults)
        guard $ not shapeChanged
        for cellResults $ \(cData, (cResult, _)) -> (cData, ) <$> cResult

  let miWidget
        = miLayout
          liveliness
          (fmap (view _1 &&& view (_2 . _1)) cellResults)
          (fmap (view $ _2 . _2) cellResults)
          (fmap (view _2) delResults)
          (Map.mapMaybeWithKey (\(dimIx, miCoord) (_, wdgt) -> wdgt <* guard (miAllowAdd miCoord dimIx liveliness)) addResults)

  MsgRenderer mr <- getMsgRenderer

  whenM ((== Just miIdent) <$> lookupCustomHeader HeaderMassInputShortcircuit) . liftHandler $ do
    PageContent{..} <- widgetToPageContent $(widgetFile "widgets/massinput/massinput-standalone")
    ur <- getUrlRenderParams

    case result of
      FormFailure errs -> forM_ errs $ addMessage Error . toHtml -- Error messages get collected by middleware and added as header to response
      _other           -> return () -- Completely ignore non-error results; we'll short circuit below

    sendResponse $ $(hamletFile "templates/widgets/massinput/massinput-standalone-wrapper.hamlet") ur

  let
    fvLabel = toHtml $ mr fsLabel
    fvTooltip = toHtml . mr <$> fsTooltip
    fvInput = $(widgetFile "widgets/massinput/massinput")
    fvErrors = Nothing
    in return (result, FieldView{..})

defaultMiLayout :: forall liveliness cellData cellResult.
                   Liveliness liveliness
                => MassInputLayout liveliness cellData cellResult
-- | Generic `miLayout` using recursively nested lists
defaultMiLayout liveliness _ cellResults delResults addResults = miWidget' boxOrigin [] $ zip [0..] boxDimensions
  where
    miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
    miWidget' _ _ [] = mempty
    miWidget' miCoord pDims (dim'@(dimIx, BoxDimension dim) : remDims) =
      let coords = Set.toList . Set.map (\c -> miCoord & dim .~ (c ^. dim)) . Set.filter (\c -> and [ ((==) `on` view pDim) miCoord c | (_, BoxDimension pDim) <- pDims ]) $ review liveCoords liveliness
          cells
            | [] <- remDims = do
                coord <- coords
                Just cellWdgt <- return $ Map.lookup coord cellResults
                let deleteButton = Map.lookup coord delResults
                return (coord, $(widgetFile "widgets/massinput/cell"))
            | otherwise =
                [ (coord, miWidget' coord (pDims `snoc` dim') remDims) | coord <- coords ]
          addWidget = Map.lookup (dimIx, miCoord) addResults
       in $(widgetFile "widgets/massinput/row")

listMiLayout :: MassInputLayout ListLength cellData cellResult
listMiLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/list/layout")


-- | Wrapper around `massInput` for the common case, that we just want an arbitrary list of single fields without any constraints
massInputList :: forall handler cellResult ident.
                 ( MonadHandler handler, HandlerSite handler ~ UniWorX
                 , MonadThrow handler
                 , PathPiece ident
                 )
              => Field handler cellResult
              -> (ListPosition -> FieldSettings UniWorX)
              -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
              -> ident
              -> FieldSettings UniWorX
              -> Bool
              -> Maybe [cellResult]
              -> (Markup -> MForm handler (FormResult [cellResult], FieldView UniWorX))
massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = over (mapped . _1 . mapped) (map snd . Map.elems) . massInput
  MassInput { miAdd = \_ _ _ submitBtn -> Just $ \csrf ->
                return (FormSuccess $ \pRes -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax pRes) (), toWidget csrf >> fvInput submitBtn)
            , miCell = \pos () iRes nudge csrf ->
                over _2 (\FieldView{..} -> $(widgetFile "widgets/massinput/list/cell")) <$> mreq field (fieldSettings pos & addName (nudge "field")) iRes
            , miDelete = miDeleteList
            , miAllowAdd = \_ _ _ -> True
            , miAddEmpty = \_ _ _ -> Set.empty
            , miButtonAction
            , miLayout = listMiLayout
            , miIdent
            }
  miSettings
  miRequired
  (Map.fromList . zip [0..] . map ((), ) <$> miPrevResult)

massInputListA :: forall handler cellResult ident.
                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
                  , MonadThrow handler
                  , PathPiece ident
                  )
               => Field handler cellResult
               -> (ListPosition -> FieldSettings UniWorX)
               -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
               -> ident
               -> FieldSettings UniWorX
               -> Bool
               -> Maybe [cellResult]
               -> AForm handler [cellResult]
massInputListA field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = formToAForm . fmap (over _2 pure) $ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult mempty


-- | Wrapper around `massInput` for the common case, that we just want a list of data with no option to modify it except deletion and addition
massInputAccum :: forall handler cellData ident.
                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
                  , MonadThrow handler
                  , ToJSON cellData, FromJSON cellData
                  , PathPiece ident
                  )
               => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
               -> (cellData -> Widget)
               -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
               -> MassInputLayout ListLength cellData ()
               -> ident
               -> FieldSettings UniWorX
               -> Bool
               -> Maybe [cellData]
               -> (Markup -> MForm handler (FormResult [cellData], FieldView UniWorX))
massInputAccum miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf
  = over (_1 . mapped) (map fst . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (, ()) <$> mPrev) csrf
  where
    miAdd :: ListPosition -> Natural
          -> (Text -> Text) -> FieldView UniWorX
          -> Maybe (Markup -> MForm handler (FormResult (Map ListPosition cellData -> FormResult (Map ListPosition cellData)), Widget))
    miAdd _pos _dim nudge submitView = Just $ \csrf' -> over (_1 . mapped) doAdd <$> miAdd' nudge submitView csrf'

    doAdd :: ([cellData] -> FormResult [cellData]) -> (Map ListPosition cellData -> FormResult (Map ListPosition cellData))
    doAdd f prevData = Map.fromList . zip [startKey..] <$> f prevElems
      where
        prevElems = Map.elems prevData
        startKey = maybe 0 succ $ fst <$> Map.lookupMax prevData

    miCell :: ListPosition -> cellData -> Maybe () -> (Text -> Text)
           -> (Markup -> MForm handler (FormResult (), Widget))
    miCell _pos dat _mPrev _nudge csrf' = return (FormSuccess (), toWidget csrf' <> miCell' dat)

    miDelete :: MassInputDelete ListLength
    miDelete = miDeleteList

    miAllowAdd _ _ _ = True

    miAddEmpty _ _ _ = Set.empty

massInputAccumA :: forall handler cellData ident.
                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
                  , MonadThrow handler
                  , ToJSON cellData, FromJSON cellData
                  , PathPiece ident
                  )
               => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
               -> (cellData -> Widget)
               -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
               -> MassInputLayout ListLength cellData ()
               -> ident
               -> FieldSettings UniWorX
               -> Bool
               -> Maybe [cellData]
               -> AForm handler [cellData]
massInputAccumA miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
  = formToAForm $ over _2 pure <$> massInputAccum miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty

massInputAccumW :: forall handler cellData ident.
                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
                  , MonadThrow handler
                  , ToJSON cellData, FromJSON cellData
                  , PathPiece ident
                  )
               => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
               -> (cellData -> Widget)
               -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
               -> MassInputLayout ListLength cellData ()
               -> ident
               -> FieldSettings UniWorX
               -> Bool
               -> Maybe [cellData]
               -> WForm handler (FormResult [cellData])
massInputAccumW miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
  = mFormToWForm $ massInputAccum miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty

  
-- | Wrapper around `massInput` for the common case, that we just want a list of data with existing data modified the same way as new data is added
massInputAccumEdit :: forall handler cellData ident.
                      ( MonadHandler handler, HandlerSite handler ~ UniWorX
                      , MonadThrow handler
                      , ToJSON cellData, FromJSON cellData
                      , PathPiece ident
                      )
                   => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
                   -> ((Text -> Text) -> cellData          -> (Markup -> MForm handler (FormResult cellData, Widget)))
                   -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
                   -> MassInputLayout ListLength cellData cellData
                   -> ident
                   -> FieldSettings UniWorX
                   -> Bool
                   -> Maybe [cellData]
                   -> (Markup -> MForm handler (FormResult [cellData], FieldView UniWorX))
massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf
  = over (_1 . mapped) (map snd . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (\x -> (x, x)) <$> mPrev) csrf
  where
    miAdd :: ListPosition -> Natural
          -> (Text -> Text) -> FieldView UniWorX
          -> Maybe (Markup -> MForm handler (FormResult (Map ListPosition cellData -> FormResult (Map ListPosition cellData)), Widget))
    miAdd _pos _dim nudge submitView = Just $ \csrf' -> over (_1 . mapped) doAdd <$> miAdd' nudge submitView csrf'

    doAdd :: ([cellData] -> FormResult [cellData]) -> (Map ListPosition cellData -> FormResult (Map ListPosition cellData))
    doAdd f prevData = Map.fromList . zip [startKey..] <$> f prevElems
      where
        prevElems = Map.elems prevData
        startKey = maybe 0 succ $ fst <$> Map.lookupMax prevData

    miCell :: ListPosition -> cellData -> Maybe cellData -> (Text -> Text)
           -> (Markup -> MForm handler (FormResult cellData, Widget))
    miCell _pos dat _mPrev nudge = miCell' nudge dat

    miDelete :: MassInputDelete ListLength
    miDelete = miDeleteList

    miAllowAdd _ _ _ = True

    miAddEmpty _ _ _ = Set.empty

massInputAccumEditA :: forall handler cellData ident.
                       ( MonadHandler handler, HandlerSite handler ~ UniWorX
                       , MonadThrow handler
                       , ToJSON cellData, FromJSON cellData
                       , PathPiece ident
                       )
                    => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
                    -> ((Text -> Text) -> cellData          -> (Markup -> MForm handler (FormResult cellData, Widget)))
                    -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
                    -> MassInputLayout ListLength cellData cellData
                    -> ident
                    -> FieldSettings UniWorX
                    -> Bool
                    -> Maybe [cellData]
                    -> AForm handler [cellData]
massInputAccumEditA miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
  = formToAForm $ over _2 pure <$> massInputAccumEdit miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty

massInputAccumEditW :: forall handler cellData ident.
                       ( MonadHandler handler, HandlerSite handler ~ UniWorX
                       , MonadThrow handler
                       , ToJSON cellData, FromJSON cellData
                       , PathPiece ident
                       )
                    => ((Text -> Text) -> FieldView UniWorX -> (Markup -> MForm handler (FormResult ([cellData] -> FormResult [cellData]), Widget)))
                    -> ((Text -> Text) -> cellData          -> (Markup -> MForm handler (FormResult cellData, Widget)))
                    -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
                    -> MassInputLayout ListLength cellData cellData
                    -> ident
                    -> FieldSettings UniWorX
                    -> Bool
                    -> Maybe [cellData]
                    -> WForm handler (FormResult [cellData])
massInputAccumEditW miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev
  = mFormToWForm $ massInputAccumEdit miAdd' miCell' miButtonAction' miLayout' miIdent' fSettings fRequired mPrev mempty


massInputA :: forall handler cellData cellResult liveliness.
           ( MonadHandler handler, HandlerSite handler ~ UniWorX
           , ToJSON cellData, FromJSON cellData
           , Liveliness liveliness
           , MonadThrow handler
           )
          => MassInput handler liveliness cellData cellResult
          -> FieldSettings UniWorX
          -> Bool -- ^ Required?
          -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
          -> AForm handler (Map (BoxCoord liveliness) (cellData, cellResult))
massInputA  mi fs fvRequired initialResult = formToAForm $
  over _2 pure <$> massInput mi fs fvRequired initialResult mempty

massInputW :: forall handler cellData cellResult liveliness.
           ( MonadHandler handler, HandlerSite handler ~ UniWorX
           , ToJSON cellData, FromJSON cellData
           , Liveliness liveliness
           , MonadThrow handler
           )
          => MassInput handler liveliness cellData cellResult
          -> FieldSettings UniWorX
          -> Bool -- ^ Required?
          -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
          -> WForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)))
massInputW mi fs fvRequired initialResult = mFormToWForm $
  massInput mi fs fvRequired initialResult mempty