{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Handler.Utils.Form.MassInput.TH
  ( tupleBoxCoord
  ) where

import Prelude
import Handler.Utils.Form.MassInput.Liveliness

import Language.Haskell.TH

import Control.Lens

import Control.Monad (replicateM)


tupleBoxCoord :: Int -> DecQ
tupleBoxCoord tupleDim = do
  cs <- replicateM tupleDim $ newName "c"

  let tupleType = foldl appT (tupleT tupleDim) $ map varT cs
      tCxt = cxt
        [ [t|IsBoxCoord $(varT c)|] | c <- cs ]
      fieldLenses =
        [ [e|_1|]
        , [e|_2|]
        , [e|_3|]
        , [e|_4|]
        ]

  instanceD tCxt ([t|IsBoxCoord|] `appT` tupleType)
    [ funD 'boxDimensions
      [ clause [] (normalB . foldr1 (\ds1 ds2 -> [e|(++)|] `appE` ds1 `appE` ds2) $ map (\field -> [e|map (\(BoxDimension dim) -> BoxDimension $ $(fieldLenses !! field) . dim) boxDimensions|]) [0..pred tupleDim]) []
      ]
    , funD 'boxOrigin
      [ clause [] (normalB . tupE $ replicate tupleDim [e|boxOrigin|]) []
      ]
    ]
