{-  Copyright 2010 Dominique Devriese

    This file is part of the grammar-combinators library.

    The grammar-combinators library is free software: you can
    redistribute it and/or modify it under the terms of the GNU
    Lesser General Public License as published by the Free
    Software Foundation, either version 3 of the License, or (at
    your option) any later version.

    Foobar is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General
    Public License along with Foobar. If not, see
    <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.GrammarCombinators.Base.MultiRec(
    module Generics.MultiRec.Base,
    module Generics.MultiRec.HFunctor,
    IL(IL, unIL),
    SubPF(SubPF)
  ) where

import Text.GrammarCombinators.Base.Domain

import Control.Applicative

import Generics.MultiRec.Base
import Generics.MultiRec.HFunctor

-- Similar to MultiRec's I type functor, but represents a list of elements
-- of the given type instead of a single value
data IL xi r ix = IL {
  unIL :: [r xi]
  }

instance (El phi xi) => HFunctor phi (IL xi) where
  hmapA = hmapAIL

hmapAIL :: forall phi a r r' xi ix. (Applicative a, El phi xi) => (forall ix1. phi ix1 -> r ix1 -> a (r' ix1))
     -> phi ix -> IL xi r ix -> a (IL xi r' ix)
hmapAIL f _ (IL l) = 
  let
    as :: [a (r' xi)]
    as = map (f proof) l
    as' :: a [r' xi]
    as' = foldr (liftA2 (:)) (pure []) as
  in liftA IL as'

-- SubPF allows including an embedded domain's PF instance in the PF 
-- instance for the enclosing domain.

-- unusedPhi' is unused, but is here to avoid the need for the
-- UndecidableInstances extension in e.g. the HFunctor instance below
data SubPF (phi :: * -> *) (phi' :: * -> *) unusedPhi' supIxT r ix where 
  SubPF :: phi' ix -> PF phi' (SubVal supIxT r) ix -> SubPF phi phi' phi' supIxT r (supIxT ix)

instance (HFunctor phi' (PF phi'), DomainEmbedding phi phi' supIxT) =>
         HFunctor phi (SubPF phi phi' phi' supIxT) where
  hmapA = hmapSubPF

hmapSubPF :: forall phi r a r' phi' supIxT ix.
             (Applicative a, HFunctor phi' (PF phi'), DomainEmbedding phi phi' supIxT) =>
             (forall ix1. phi ix1 -> r ix1 -> a (r' ix1)) ->
             phi ix ->
             SubPF phi phi' phi' supIxT r ix ->
             a (SubPF phi phi' phi' supIxT r' ix)
hmapSubPF f _ (SubPF (idx :: phi' ix') pfb) = 
  let
    subF :: forall ix2. phi' ix2 -> SubVal supIxT r ix2 -> a (SubVal supIxT r' ix2)
    subF idx' v = liftA MkSubVal $ f (supIx idx') $ unSubVal v
    pfm :: a (PF phi' (SubVal supIxT r') ix')
    pfm = hmapA subF idx pfb
  in liftA (SubPF idx) pfm