free-theorems 0.2 → 0.2.1
raw patch · 2 files changed
+42/−16 lines, 2 filesdep ~haskell-src-extsnew-uploader
Dependency ranges changed: haskell-src-exts
Files
free-theorems.cabal view
@@ -1,5 +1,5 @@ name: free-theorems-version: 0.2+version: 0.2.1 license: PublicDomain license-file: LICENSE author: Sascha Boehme@@ -23,7 +23,7 @@ base >= 1.0 , mtl >= 1.0 , haskell-src >= 1.0- , haskell-src-exts >= 0.2.1+ , haskell-src-exts >= 0.3.9 , pretty >= 1.0.0.0 , containers >= 0.1.0.1 exposed-modules:@@ -49,3 +49,15 @@ Language.Haskell.FreeTheorems.PrettyTheorems hs-source-dirs: src extensions: Generics, DeriveDataTypeable, Rank2Types, PatternSignatures+extra-source-files:+ src/Arbitraries.hs+ src/FrontendCheckGlobalTests.hs+ src/FrontendCheckLocalTests.hs+ src/FrontendOtherTests.hs+ src/FrontendTypeExpressionsTests.hs+ src/InterpretationTests.hs+ src/ParserPrettyPrinterTests.hs+ src/Runtests.hs+ src/Tests.hs+ README+ runtests
src/Language/Haskell/FreeTheorems/Parser/Hsx.hs view
@@ -12,8 +12,8 @@ import Data.Generics (everywhere, mkT) import Data.Maybe (fromMaybe) import Data.List (nub, (\\), intersect)-import Language.Haskell.Hsx.Parser (parseModule, ParseResult(..))-import Language.Haskell.Hsx.Syntax+import Language.Haskell.Exts.Parser (parseModule, ParseResult(..))+import Language.Haskell.Exts.Syntax import Text.PrettyPrint import qualified Language.Haskell.FreeTheorems.Syntax as S@@ -98,8 +98,7 @@ where isAcceptedDeclaration decl = case decl of HsTypeDecl _ _ _ _ -> True- HsDataDecl _ _ _ _ _ _ -> True- HsNewTypeDecl _ _ _ _ _ _ -> True+ HsDataDecl _ _ _ _ _ _ _ -> True HsClassDecl _ _ _ _ _ _ -> True HsTypeSig _ _ _ -> True otherwise -> False@@ -126,18 +125,30 @@ ------- Transform declarations ------------------------------------------------ +-- | Transforms a class declaration.++clsDeclToDecl :: HsClassDecl -> ErrorOr HsDecl+clsDeclToDecl decl = case decl of+ HsClsDecl decl -> return decl+ HsClsDataFam _ _ _ _ _ -> throwError noDataFam+ HsClsTyFam _ _ _ _ -> throwError noTypeFam+ HsClsTyDef _ _ _ -> throwError noTypeFam++noDataFam = pp "Data Families are not allowed"+noTypeFam = pp "Type Families are not allowed"+ -- | Transforms a declaration. mkDeclaration :: HsDecl -> ErrorOr S.Declaration mkDeclaration decl = case decl of- HsTypeDecl l n vs t -> addErr l n (mkType n vs t)- HsDataDecl l _ n vs cs _ -> addErr l n (mkData n vs cs)- HsNewTypeDecl l _ n vs c _ -> addErr l n (mkNewtype n vs c)- HsClassDecl l scs n [v] _ ds -> addErr l n (mkClass scs n v ds)- HsTypeSig l [n] t -> addErr l n (mkSignature n t)+ HsTypeDecl l n vs t -> addErr l n (mkType n vs t)+ HsDataDecl l DataType _ n vs cs _ -> addErr l n (mkData n vs cs)+ HsDataDecl l NewType _ n vs [c] _ -> addErr l n (mkNewtype n vs c)+ HsClassDecl l scs n [v] _ ds -> addErr l n (mkClass scs n v ds)+ HsTypeSig l [n] t -> addErr l n (mkSignature n t) - HsClassDecl l _ n [] _ _ -> addErr l n (throwError missingVar)- HsClassDecl l _ n (_:_:_) _ _ -> addErr l n (throwError noMultiParam)+ HsClassDecl l _ n [] _ _ -> addErr l n (throwError missingVar)+ HsClassDecl l _ n (_:_:_) _ _ -> addErr l n (throwError noMultiParam) -- no other case con occur, see above function 'filterDeclarations'. @@ -242,11 +253,12 @@ -- | Transforms the components of a Haskell class declaration. -- Every declaration in the class body is ignored except of type signatures. -mkClass :: HsContext -> HsName -> HsName -> [HsDecl] -> ErrorOr S.Declaration-mkClass ctx name var decls = do+mkClass :: HsContext -> HsName -> HsName -> [HsClassDecl] -> ErrorOr S.Declaration+mkClass ctx name var clsDecls = do ident <- mkIdentifier name tv <- mkTypeVariable var superCs <- mkContext ctx >>= check tv+ decls <- mapM clsDeclToDecl clsDecls sigs <- liftM (map toSig) (mapM mkDeclaration (filter isSig decls)) -- mapping 'isSig' is safe because after applying 'filter' no other -- declarations are left except of type signatures@@ -354,7 +366,9 @@ return (S.TypeCon (S.ConTuple (length ts)) ts) mkTypeExpressionT (HsTyForall maybeVars ctx ty) =- mkForallTyEx (fromMaybe [] maybeVars) ctx ty+ mkForallTyEx (maybe [] (map unKind) maybeVars) ctx ty+ where unKind (HsKindedVar n _) = n+ unKind (HsUnkindedVar n) = n mkTypeExpressionT (HsTyPred _) = throwError (pp "Implicit parameters are not allowed.")