{- 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