packages feed

multirec 0.4.1 → 0.5

raw patch · 18 files changed

+221/−28 lines, 18 filesdep ~template-haskell

Dependency ranges changed: template-haskell

Files

examples/ASTExamples.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE GADTs                #-}  module ASTExamples where @@ -20,6 +21,7 @@ import Generics.MultiRec.FoldAlg as FA import Generics.MultiRec.Eq import Generics.MultiRec.Show as GS+import Generics.MultiRec.Read as GR  -- | Example expression @@ -121,3 +123,8 @@  testShow :: IO () testShow = putStrLn $ GS.show Expr example++-- | Test for generic show, read and equality++testReadShowEq :: Bool+testReadShowEq = GR.read Expr (GS.show Expr example) == example
examples/ASTUse.hs view
@@ -98,3 +98,10 @@    to Var  (R (R (Tag (K x))))                                    =  x +-- ** EqS instance++instance EqS AST where+  eqS Expr Expr = Just Refl+  eqS Decl Decl = Just Refl+  eqS Var  Var  = Just Refl+  eqS _    _    = Nothing
multirec.cabal view
@@ -1,5 +1,5 @@ name:                 multirec-version:              0.4.1+version:              0.5 license:              BSD3 license-file:         LICENSE author:               Alexey Rodriguez,@@ -37,10 +37,21 @@ stability:            experimental build-type:           Simple cabal-version:        >= 1.2.1-tested-with:          GHC == 6.8.3, GHC == 6.10.3, GHC == 6.12.1-hs-source-dirs:       src-exposed-modules:      Generics.MultiRec+tested-with:          GHC == 6.10.4, GHC == 7.0.1+extra-source-files:   examples/AST.hs+                      examples/ASTUse.hs+                      examples/ASTTHUse.hs+                      examples/ASTExamples.hs+                      examples/Single.hs+                      examples/SingleUse.hs+                      examples/SingleTHUse.hs+                      examples/SingleExamples.hs+                      CREDITS +library+  hs-source-dirs:     src+  exposed-modules:    Generics.MultiRec+                       -- Base                       Generics.MultiRec.Base                       Generics.MultiRec.Constructor@@ -56,18 +67,10 @@                       Generics.MultiRec.FoldAlgK                       Generics.MultiRec.Compos                       Generics.MultiRec.Eq+                      Generics.MultiRec.Read                       Generics.MultiRec.Show                        -- Extra                       Generics.MultiRec.TEq -extra-source-files:   examples/AST.hs-                      examples/ASTUse.hs-                      examples/ASTTHUse.hs-                      examples/ASTExamples.hs-                      examples/Single.hs-                      examples/SingleUse.hs-                      examples/SingleTHUse.hs-                      examples/SingleExamples.hs-                      CREDITS-build-depends:        base >= 3.0 && < 5, template-haskell >= 2.2 && < 2.5+  build-depends:      base >= 3.0 && < 5, template-haskell >= 2.2 && < 2.6
src/Generics/MultiRec/Base.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Base--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/Compos.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Compos--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/ConNames.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.ConNames--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/Constructor.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Constructor--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/Eq.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Eq--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/Fold.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Fold--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org@@ -96,3 +96,4 @@  con :: AlgPart a r ix -> AlgPart (C c a) r ix con f (C x) = f x+
src/Generics/MultiRec/FoldAlg.hs view
@@ -11,7 +11,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.FoldAlg--- Copyright   :  (c) 2009 Universiteit Utrecht+-- Copyright   :  (c) 2009--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/FoldAlgK.hs view
@@ -11,7 +11,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.FoldAlgK--- Copyright   :  (c) 2009 Universiteit Utrecht+-- Copyright   :  (c) 2009--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/FoldK.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.FoldK--- Copyright   :  (c) 2009 Universiteit Utrecht+-- Copyright   :  (c) 2009--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/HFix.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.HFix--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/HFunctor.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.HFunctor--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
+ src/Generics/MultiRec/Read.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE KindSignatures        #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-}+{-# LANGUAGE PatternSignatures     #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Generics.MultiRec.Read+-- Copyright   :  (c) 2009--2010 Universiteit Utrecht+-- License     :  BSD3+--+-- Maintainer  :  generics@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable+--+-- Generic read.+--+-----------------------------------------------------------------------------+module Generics.MultiRec.Read where++import Generics.MultiRec.Base++import Data.Char+import Control.Monad+import Text.Read hiding (readsPrec, readPrec)+import Prelude hiding (readsPrec)+import qualified Prelude as P (readsPrec)+++-- Based on Rui Barbosa's solution.+++-- Count the number of terms in a product++class CountAtoms (f :: (* -> *) -> * -> *) where +  countatoms :: f r ix -> Int++instance CountAtoms (K a) where+  countatoms _ = 1++instance CountAtoms (I xi) where+  countatoms _ = 1++instance (CountAtoms f, CountAtoms g) => CountAtoms (f :*: g) where+  countatoms (_ :: (f :*: g) r ix) = countatoms (undefined :: f r ix) + countatoms (undefined :: g r ix)++-- * Generic read++class HReadPrec (phi :: * -> *) (f :: (* -> *) -> * -> *) where+   hreader :: forall ix . phi ix -> (forall ix1 . phi ix1 -> ReadPrec (I0 ix1)) -> ReadPrec (f I0 ix)+++instance HReadPrec phi U where+   hreader p f = return U++instance (Read a) => HReadPrec phi (K a) where+   hreader p f = liftM K (readS_to_Prec P.readsPrec)++instance (El phi xi) => HReadPrec phi (I xi) where+   hreader p f = liftM I (f proof)++instance (HReadPrec phi f, HReadPrec phi g) => HReadPrec phi (f :+: g) where+   hreader p f = liftM L (hreader p f)  +++ liftM R (hreader p f)++instance (HReadPrec phi f, HReadPrec phi g) => HReadPrec phi (f :*: g) where+   hreader p f = liftM2 (:*:) (hreader p f) (hreader p f)++instance (HReadPrec phi f, EqS phi, El phi ix) => HReadPrec phi (f :>: ix) where+   hreader p f = case eqS p (proof :: phi ix) of +                       Nothing    ->  pfail+                       Just Refl  ->  liftM Tag (hreader p f)++-- Dealing with constructors++-- No arguments+instance (Constructor c) => HReadPrec phi (C c U) where+   hreader p f = let constr = undefined :: C c U I0 ix+                     name   = conName constr+                 in readCons (readNoArgsCons p f name)++-- 1 argument+instance (Constructor c, HReadPrec phi (I xi)) => HReadPrec phi (C c (I xi)) where+   hreader p f = let constr = undefined :: C c (I xi) I0 ix+                     name   = conName constr+                 in  readCons (readPrefixCons p f True name)++instance (Constructor c, HReadPrec phi (K a)) => HReadPrec phi (C c (K a)) where+   hreader p f = let constr = undefined :: C c (K a) I0 ix+                     name   = conName constr+                 in  readCons (readPrefixCons p f True name) ++-- 2 arguments or more+instance forall f g phi c . (Constructor c, CountAtoms (f :*: g), HReadPrec phi f , HReadPrec phi g) => HReadPrec phi (C c (f:*:g)) where+   hreader p f = let constr = undefined :: C c (f:*:g) I0 ix+                     name   = conName constr+                     fixity = conFixity constr+                     (assoc,prc,isInfix) = case fixity of +                                            Prefix      -> (LeftAssociative, 9, False)+                                            Infix a p   -> (a, p, True)+                     --K0F nargs  = countatoms  :: K0F Int (f:*:g)+                     nargs  = countatoms (undefined :: (f :*: g) r ix)+                  in   readCons $  +                               readPrefixCons p f (not isInfix) name+                                        ++++                               (do guard (nargs==2)+                                   readInfixCons p f (assoc,prc,isInfix) name+                               )+++readCons :: (Constructor c) => ReadPrec (f I0 ix) -> ReadPrec (C c f I0 ix)+readCons = liftM C++readPrefixCons :: (HReadPrec phi f) => +                     phi ix  +                  -> (forall ix1. phi ix1 -> ReadPrec (I0 ix1)) +                  -> Bool -> String -> ReadPrec (f I0 ix)+readPrefixCons p f b name = parens . prec appPrec $+                            do parens (prefixConsNm name b) +                               step (hreader p f)+    where prefixConsNm name True  = do Ident n <- lexP+                                       guard (name == n)+          prefixConsNm name False = do Punc "(" <-lexP+                                       Symbol n <- lexP+                                       guard (name==n)   +                                       Punc ")" <- lexP+                                       return ()+++readInfixCons :: (HReadPrec phi f, HReadPrec phi g) => +                    phi ix +                 -> (forall ix1. phi ix1 -> ReadPrec (I0 ix1)) +                 -> (Associativity,Int,Bool) -> String -> ReadPrec ((f :*: g) I0 ix)+readInfixCons p f (asc,prc,b) name = parens . prec prc $+                                       do x <- {- (if asc == LeftAssociative  then id else step) -} step (hreader p f)+                                          parens (infixConsNm name b)+                                          y <- (if asc == RightAssociative then id else step) (hreader p f)+                                          return  (x :*: y)+     where  infixConsNm name True  = do Symbol n <- lexP +                                        guard (n==name) +            infixConsNm name False = do Punc "`"  <- lexP+                                        Ident n   <- lexP  +                                        guard (n==name)+                                        Punc "`"  <- lexP +                                        return ()++readNoArgsCons ::   phi ix +                 -> (forall ix1. phi ix1 -> ReadPrec (I0 ix1)) +                 -> String -> ReadPrec (U I0 ix)+readNoArgsCons p f name = parens $ +                             do Ident n <- lexP+                                guard (n==name)+                                return U++appPrec = 10+++-- Exported functions++readPrec :: (Fam phi, HReadPrec phi (PF phi)) => phi ix -> ReadPrec ix+readPrec p = liftM (to p)  (hreader p (liftM I0 . readPrec))+++readsPrec :: (Fam phi, HReadPrec phi (PF phi)) => phi ix -> Int -> ReadS ix+readsPrec = readPrec_to_S . readPrec ++read :: (Fam phi, HReadPrec phi (PF phi)) => phi ix -> String -> ix+read p s = case [x |  (x,remain) <- readsPrec p 0 s , all isSpace remain] of+               [x] -> x +               [ ] -> error "no parse"+               _   -> error "ambiguous parse"
src/Generics/MultiRec/Show.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.Show--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/TEq.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.TEq--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org
src/Generics/MultiRec/TH.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Generics.MultiRec.TH--- Copyright   :  (c) 2008--2009 Universiteit Utrecht+-- Copyright   :  (c) 2008--2010 Universiteit Utrecht -- License     :  BSD3 -- -- Maintainer  :  generics@haskell.org