fay 0.23.1.8 → 0.23.1.9

raw patch · 33 files changed

+137/−134 lines, 33 filesdep +base-compatdep ~haskell-src-extsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base-compat

Dependency ranges changed: haskell-src-exts

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• fay.cabal +7/−6
• src/Fay.hs +4/−1
• src/Fay/Compiler.hs +3/−3
• src/Fay/Compiler/Decl.hs +3/−3
• src/Fay/Compiler/Desugar.hs +3/−3
• src/Fay/Compiler/Exp.hs +3/−3
• src/Fay/Compiler/FFI.hs +2/−2
• src/Fay/Compiler/Import.hs +4/−4
• src/Fay/Compiler/InitialPass.hs +3/−3
• src/Fay/Compiler/Misc.hs +1/−1
• src/Fay/Compiler/ModuleT.hs +3/−2
• src/Fay/Compiler/Optimizer.hs +2/−2
• src/Fay/Compiler/Packages.hs +2/−3
• src/Fay/Compiler/Pattern.hs +3/−3
• src/Fay/Compiler/Prelude.hs +17/−19
• src/Fay/Compiler/Print.hs +2/−3
• src/Fay/Config.hs +1/−1
• src/Fay/Convert.hs +2/−1
• src/haskell-names/Language/Haskell/Names/Annotated.hs +1/−2
• src/haskell-names/Language/Haskell/Names/Exports.hs +10/−12
• src/haskell-names/Language/Haskell/Names/GetBound.hs +4/−2
• src/haskell-names/Language/Haskell/Names/GlobalSymbolTable.hs +1/−4
• src/haskell-names/Language/Haskell/Names/Imports.hs +10/−11
• src/haskell-names/Language/Haskell/Names/LocalSymbolTable.hs +2/−1
• src/haskell-names/Language/Haskell/Names/Open/Base.hs +2/−4
• src/haskell-names/Language/Haskell/Names/Open/Derived.hs +2/−0
• src/haskell-names/Language/Haskell/Names/Open/Instances.hs +16/−19
• src/haskell-names/Language/Haskell/Names/ScopeUtils.hs +1/−3
• src/haskell-names/Language/Haskell/Names/SyntaxUtils.hs +1/−1
• src/haskell-names/Language/Haskell/Names/Types.hs +1/−3
• src/tests/Test/Desugar.hs +13/−7
• src/tests/Tests.hs +4/−2

@@ -2,6 +2,10 @@  See full history at: <https://github.com/faylang/fay/commits> +#### 0.23.1.9++* Allow and require `haskell-src-exts 1.17.*`+ #### 0.23.1.8  * Allow `vector 0.11.*`

@@ -1,5 +1,5 @@ name:                fay-version:             0.23.1.8+version:             0.23.1.9 synopsis:            A compiler for Fay, a Haskell subset that compiles to JavaScript. description:         Fay is a proper subset of Haskell which is type-checked                      with GHC, and compiled to JavaScript. It is lazy, pure, has a Fay monad,@@ -136,7 +136,8 @@    build-depends:       base >= 4 && < 4.9-    , aeson > 0.6 && < 0.10+    , base-compat == 0.8.*+    , aeson > 0.6 && < 0.11     , bytestring < 0.11     , containers < 0.6     , data-default < 0.6@@ -144,7 +145,7 @@     , directory < 1.3     , filepath < 1.5     , ghc-paths < 0.2-    , haskell-src-exts >= 1.16 && < 1.17+    , haskell-src-exts == 1.17.*     , language-ecmascript >= 0.15 && < 0.18     , mtl < 2.3     , mtl-compat >= 0.1 && < 0.3@@ -153,7 +154,7 @@     , sourcemap < 0.2     , split < 0.3     , spoon < 0.4-    , syb < 0.6+    , syb < 0.7     , text < 1.3     , time >= 1 && < 1.6     , transformers >= 0.3 && < 0.4 || > 0.4.1 && < 0.5@@ -177,7 +178,7 @@       base     , fay     , mtl-    , optparse-applicative == 0.11.*+    , optparse-applicative >= 0.11 && < 0.13     , split  executable fay-tests@@ -204,7 +205,7 @@       , groom == 0.1.*       , haskell-src-exts       , random >= 1.0 && < 1.2-      , tasty >= 0.9 && < 0.11+      , tasty >= 0.9 && < 0.12       , tasty-hunit >= 0.8 && < 0.10       , tasty-th == 0.1.*       , text

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude     #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE RecordWildCards       #-} {-# LANGUAGE TypeSynonymInstances  #-}@@ -23,14 +24,16 @@   ,getRuntime   ) where +import           Fay.Compiler.Prelude+ import           Fay.Compiler import           Fay.Compiler.Misc                      (ioWarn, printSrcSpanInfo) import           Fay.Compiler.Packages-import           Fay.Compiler.Prelude import           Fay.Compiler.Typecheck import           Fay.Config import qualified Fay.Exts                               as F import           Fay.Types+ import           Data.Aeson                             (encode) import qualified Data.ByteString.Lazy                   as L import           Language.Haskell.Exts.Annotated        (prettyPrint)

@@ -42,12 +42,12 @@ import qualified Fay.Exts.NoAnnotation           as N import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.RWS+import           Control.Monad.Except            (throwError)+import           Control.Monad.RWS               (gets, modify)  import qualified Data.Set                        as S import           Language.Haskell.Exts.Annotated hiding (name)-import           Language.Haskell.Names (annotateModule)+import           Language.Haskell.Names          (annotateModule)  -------------------------------------------------------------------------------- -- Top level entry points

@@ -21,8 +21,8 @@ import qualified Fay.Exts.Scoped                 as S import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.RWS+import           Control.Monad.Except            (throwError)+import           Control.Monad.RWS               (gets, modify) import           Language.Haskell.Exts.Annotated hiding (binds, loc, name)  -- | Compile Haskell declaration.@@ -161,7 +161,7 @@         JsSetConstructor qname $           JsFun (Just $ JsConstructor qname)                 fields-                (for fields $ \field -> JsSetProp JsThis field (JsName field))+                (flip fmap fields $ \field -> JsSetProp JsThis field (JsName field))                 Nothing      -- Creates a function to initialize the record by regular application

@@ -14,11 +14,11 @@ import           Fay.Compiler.Desugar.Name import           Fay.Compiler.Desugar.Types import           Fay.Compiler.Misc               (ffiExp, hasLanguagePragma)-import           Fay.Compiler.QName              (unname, unQual)+import           Fay.Compiler.QName              (unQual, unname) import           Fay.Exts.NoAnnotation           (unAnn) import           Fay.Types                       (CompileError (..)) -import           Control.Monad.Except+import           Control.Monad.Except            (throwError) import           Control.Monad.Reader            (asks) import qualified Data.Generics.Uniplate.Data     as U import           Language.Haskell.Exts.Annotated hiding (binds, loc, name)@@ -28,7 +28,7 @@ desugar = desugar' "$gen"  -- | Desugar with the option to specify a prefix for generated names.--- Useful if you want to provide valid haskell name that HSE can print.+-- Useful if you want to provide valid haskell names that HSE can print. desugar' :: (Data l, Typeable l) => String -> l -> Module l -> IO (Either CompileError (Module l)) desugar' prefix emptyAnnotation md = runDesugar prefix emptyAnnotation $       checkEnum md

@@ -27,11 +27,11 @@ import qualified Fay.Exts.Scoped                 as S import           Fay.Types -import           Control.Monad.Except             (throwError)+import           Control.Monad.Except            (throwError) import           Control.Monad.RWS               (asks, gets) import qualified Data.Char                       as Char import           Language.Haskell.Exts.Annotated hiding (alt, binds, name, op)-import           Language.Haskell.Names (Scoped (Scoped), NameInfo (RecExpWildcard))+import           Language.Haskell.Names          (NameInfo (RecExpWildcard), Scoped (Scoped))  -- | Compile Haskell expression. compileExp :: S.Exp -> Compile JsExp@@ -291,7 +291,7 @@       exp <- compileExp value       return [JsSetProp (JsNameVar $ withIdent lowerFirst $ unQualify o) (JsNameVar $ unQualify field) exp]     updateStmt o (FieldWildcard (wildcardFields -> fields)) =-      return $ for fields $ \fieldName -> JsSetProp (JsNameVar . withIdent lowerFirst . unQualify . unAnn $ o)+      return $ flip fmap fields $ \fieldName -> JsSetProp (JsNameVar . withIdent lowerFirst . unQualify . unAnn $ o)                                                     (JsNameVar fieldName)                                                     (JsName $ JsNameVar fieldName)     -- I couldn't find a code that generates (FieldUpdate (FieldPun ..))

@@ -25,8 +25,8 @@ import qualified Fay.Exts.Scoped                        as S import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.Writer+import           Control.Monad.Except                   (throwError)+import           Control.Monad.Writer                   (tell) import           Data.Generics.Schemes import           Language.ECMAScript3.Parser            as JS import           Language.ECMAScript3.Syntax

@@ -7,8 +7,8 @@ -- which at this point is InitialPass's preprocessing -- and Compiler's code generation module Fay.Compiler.Import-  (startCompile-  ,compileWith+  ( startCompile+  , compileWith   ) where  import           Fay.Compiler.Prelude@@ -20,8 +20,8 @@ import           Fay.Exts.NoAnnotation           (unAnn) import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.RWS+import           Control.Monad.Except            (throwError)+import           Control.Monad.RWS               (ask, get, gets, lift, listen, modify) import           Language.Haskell.Exts.Annotated hiding (name, var) import           System.Directory import           System.FilePath

@@ -19,8 +19,8 @@ import           Fay.Exts.NoAnnotation           (unAnn) import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.RWS+import           Control.Monad.Except            (throwError)+import           Control.Monad.RWS               (modify) import qualified Data.Map                        as M import           Language.Haskell.Exts.Annotated hiding (name, var) import qualified Language.Haskell.Names          as HN (getInterfaces)@@ -90,7 +90,7 @@ scanRecordDecls decl = do   case decl of     DataDecl _loc ty _ctx (F.declHeadName -> name) qualcondecls _deriv -> do-      let addIt = let ns = for qualcondecls (\(QualConDecl _loc' _tyvarbinds _ctx' condecl) -> conDeclName condecl)+      let addIt = let ns = flip fmap qualcondecls (\(QualConDecl _loc' _tyvarbinds _ctx' condecl) -> conDeclName condecl)                   in addRecordTypeState name ns       case ty of         DataType{} -> addIt

@@ -20,7 +20,7 @@ import qualified Fay.Exts.Scoped                 as S import           Fay.Types -import           Control.Monad.Except+import           Control.Monad.Except            (runExceptT, throwError) import           Control.Monad.RWS               (asks, gets, modify, runRWST) import           Data.Version                    (parseVersion) import           Language.Haskell.Exts.Annotated hiding (name)

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeSynonymInstances       #-} module Fay.Compiler.ModuleT@@ -26,10 +27,10 @@   , ModName (..)   ) where -import           Control.Applicative+import           Fay.Compiler.Prelude+ import           Control.Monad.Reader import           Control.Monad.State-import           Control.Monad.Writer import qualified Data.Char            as Char (isAlphaNum, isUpper) import qualified Data.Map             as Map 

@@ -13,8 +13,8 @@ import           Fay.Compiler.Misc import           Fay.Types -import           Control.Monad.State-import           Control.Monad.Writer+import           Control.Monad.State             (State, modify, runState)+import           Control.Monad.Writer            (runWriter, tell) import qualified Fay.Exts.NoAnnotation           as N import           Language.Haskell.Exts.Annotated hiding (app, name, op) 

@@ -1,7 +1,6 @@-{-# LANGUAGE TupleSections #-}-+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TupleSections     #-} -- | Dealing with Cabal packages in Fay's own special way.- module Fay.Compiler.Packages where  import           Fay.Compiler.Prelude

@@ -15,10 +15,10 @@ import qualified Fay.Exts.Scoped                 as S import           Fay.Types -import           Control.Monad.Except-import           Control.Monad.Reader+import           Control.Monad.Except            (throwError)+import           Control.Monad.Reader            (ask) import           Language.Haskell.Exts.Annotated hiding (name)-import           Language.Haskell.Names (Scoped (Scoped), NameInfo (RecPatWildcard))+import           Language.Haskell.Names          (NameInfo (RecPatWildcard), Scoped (Scoped))  -- | Compile the given pattern against the given expression. compilePat :: JsExp -> S.Pat -> [JsStmt] -> Compile [JsStmt]

@@ -1,46 +1,48 @@ -- | Re-exports of base functionality. Note that this module is just -- used inside the compiler. It's not compiled to JavaScript. -- Based on the base-extended package (c) 2013 Simon Meier, licensed as BSD3.+{-# LANGUAGE NoImplicitPrelude #-} module Fay.Compiler.Prelude-  ( module Prelude       -- Partial+  ( module Prelude.Compat -- Partial    -- * Control modules   , module Control.Applicative   , module Control.Arrow -- Partial-  , module Control.Monad+  , module Control.Monad.Compat    -- * Data modules-  , module Data.Char     -- Partial-  , module Data.Data     -- Partial+  , module Data.Char -- Partial+  , module Data.Data -- Partial   , module Data.Either   , module Data.Function-  , module Data.List     -- Partial+  , module Data.List.Compat -- Partial   , module Data.Maybe-  , module Data.Monoid   -- Partial+  , module Data.Monoid -- Partial   , module Data.Ord+  , module Data.Traversable    -- * Safe   , module Safe    -- * Additions   , anyM-  , for   , io   , readAllFromProcess   ) where  import           Control.Applicative-import           Control.Arrow       (first, second, (&&&), (***), (+++), (|||))-import           Control.Monad       hiding (guard)-import           Data.Char           hiding (GeneralCategory (..))-import           Data.Data           (Data (..), Typeable)+import           Control.Arrow        (first, second, (&&&), (***), (+++), (|||))+import           Control.Monad.Compat hiding (guard)+import           Data.Char            hiding (GeneralCategory (..))+import           Data.Data            (Data (..), Typeable) import           Data.Either-import           Data.Function       (on)-import           Data.List           hiding (delete)+import           Data.Function        (on)+import           Data.List.Compat import           Data.Maybe-import           Data.Monoid         (Monoid (..), (<>))+import           Data.Monoid          (Monoid (..), (<>)) import           Data.Ord-import           Prelude             hiding (exp, mod)+import           Data.Traversable+import           Prelude.Compat       hiding (exp, mod) import           Safe  import           Control.Monad.Except@@ -54,10 +56,6 @@ -- | Do any of the (monadic) predicates match? anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool anyM p l = return . not . null =<< filterM p l---- | Flip of map.-for :: (Functor f) => f a -> (a -> b) -> f b-for = flip fmap  -- | Read from a process returning both std err and out. readAllFromProcess :: FilePath -> [String] -> String -> IO (Either (String,String) (String,String))

@@ -1,12 +1,11 @@ {-# OPTIONS -fno-warn-orphans     #-}-{-# LANGUAGE OverloadedStrings    #-}-+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} -- | Code printers. Can be used to produce both pretty and not -- pretty output. -- -- Special constructors and symbols in Haskell are encoded to -- JavaScript appropriately.- module Fay.Compiler.Print where  import           Fay.Compiler.Prelude

@@ -1,5 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-} -- | Configuring the compiler- module Fay.Config   ( Config       ( configOptimize

@@ -1,3 +1,4 @@+{-# LANGUAGE NoImplicitPrelude   #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE PatternGuards       #-} {-# LANGUAGE RankNTypes          #-}@@ -18,7 +19,7 @@  import           Fay.Compiler.Prelude -import           Control.Monad.State+import           Control.Monad.State   (evalStateT, get, lift, put) import           Control.Spoon import           Data.Aeson import           Data.Aeson.Types      (parseEither)

@@ -17,6 +17,7 @@   , annotate   ) where +import           Fay.Compiler.Prelude import qualified Language.Haskell.Names.GlobalSymbolTable as Global import qualified Language.Haskell.Names.LocalSymbolTable  as Local import           Language.Haskell.Names.Open.Base@@ -24,10 +25,8 @@ import           Language.Haskell.Names.RecordWildcards import           Language.Haskell.Names.Types -import           Control.Applicative import           Data.Lens.Light import           Data.Proxy-import           Data.Typeable                            (Typeable) import           Language.Haskell.Exts.Annotated import           Type.Eq 

@@ -1,10 +1,13 @@ {-# OPTIONS -fno-warn-name-shadowing #-}-{-# LANGUAGE NoMonoLocalBinds #-}-{-# LANGUAGE TypeFamilies     #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE NoMonoLocalBinds  #-}+{-# LANGUAGE TypeFamilies      #-} module Language.Haskell.Names.Exports   ( processExports   ) where +import           Fay.Compiler.Prelude+ import           Fay.Compiler.ModuleT import           Language.Haskell.Names.GlobalSymbolTable as Global import           Language.Haskell.Names.ModuleSymbols@@ -13,11 +16,7 @@ import           Language.Haskell.Names.Types             (Error (..), GName (..), ModuleNameS, NameInfo (..),                                                            Scoped (..), Symbols (..), mkTy, mkVal, st_origName) -import           Control.Applicative-import           Control.Arrow-import           Control.Monad-import           Control.Monad.Writer-import           Data.Data+import           Control.Monad.Writer                     (WriterT (WriterT), runWriterT) import qualified Data.Map                                 as Map import qualified Data.Set                                 as Set import           Language.Haskell.Exts.Annotated@@ -51,7 +50,7 @@   -> m (ExportSpec (Scoped l), Symbols) resolveExportSpec tbl exp =   case exp of-    EVar l ns@(NoNamespace {}) qn -> return $+    EVar l qn -> return $       case Global.lookupValue qn tbl of         Global.Error err ->           (scopeError err exp, mempty)@@ -59,20 +58,19 @@           let s = mkVal i           in             (EVar (Scoped (Export s) l)-              (noScope ns)               (Scoped (GlobalValue i) <$> qn), s)         Global.Special {} -> error "Global.Special in export list?"-    EVar _ (TypeNamespace {}) _ -> error "'type' namespace is not supported yet" -- FIXME-    EAbs l qn -> return $+    EAbs l ns qn -> return $       case Global.lookupType qn tbl of         Global.Error err ->           (scopeError err exp, mempty)         Global.Result i ->           let s = mkTy i           in-            (EAbs (Scoped (Export s) l)+            (EAbs (Scoped (Export s) l) (noScope ns)               (Scoped (GlobalType i) <$> qn), s)         Global.Special {} -> error "Global.Special in export list?"+    EAbs _ NoNamespace{} _ -> error "resolveExportSpec: 'type' namespace is not supported yet" -- FIXME     EThingAll l qn -> return $       case Global.lookupType qn tbl of         Global.Error err ->

@@ -2,21 +2,22 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE NamedFieldPuns         #-}+{-# LANGUAGE NoImplicitPrelude      #-} {-# LANGUAGE ScopedTypeVariables    #-} {-# LANGUAGE UndecidableInstances   #-} module Language.Haskell.Names.GetBound   ( GetBound(..)   ) where +import           Fay.Compiler.Prelude import qualified Language.Haskell.Names.GlobalSymbolTable as Global import           Language.Haskell.Names.RecordWildcards import           Language.Haskell.Names.SyntaxUtils -import           Control.Applicative-import           Data.Data import           Data.Generics.Uniplate.Data import           Language.Haskell.Exts.Annotated + -- | Get bound value identifiers. class GetBound a l | a -> l where     -- | For record wildcards we need to know which fields the given@@ -72,6 +73,7 @@       InlineConlikeSig{} -> []       ClosedTypeFamDecl{} -> []       MinimalPragma{} -> []+      _ -> error "Unsupported syntax"  instance (Data l) => GetBound (QualConDecl l) l where     getBound ctx (QualConDecl _ _ _ d) = getBound ctx d

@@ -13,15 +13,12 @@   , toSymbols   ) where +import           Fay.Compiler.Prelude               hiding (empty) import           Language.Haskell.Names.SyntaxUtils import           Language.Haskell.Names.Types -import           Control.Applicative                hiding (empty)-import           Control.Arrow-import           Data.Data import           Data.Lens.Light import qualified Data.Map                           as Map-import           Data.Monoid import qualified Data.Set                           as Set import           Language.Haskell.Exts.Annotated    as HSE 

@@ -1,23 +1,22 @@-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE TypeFamilies  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PatternGuards     #-}+{-# LANGUAGE TypeFamilies      #-} {-# OPTIONS -fno-warn-name-shadowing #-} {-# OPTIONS -fno-warn-orphans #-} -- ModName (ModuleName l) module Language.Haskell.Names.Imports (processImports) where +import           Fay.Compiler.Prelude+ import           Fay.Compiler.ModuleT import qualified Language.Haskell.Names.GlobalSymbolTable as Global import           Language.Haskell.Names.ScopeUtils import           Language.Haskell.Names.SyntaxUtils import           Language.Haskell.Names.Types -import           Control.Applicative-import           Control.Arrow-import           Control.Monad.Writer-import           Data.Either-import           Data.Foldable                            (fold, foldMap)+import           Control.Monad.Writer                     (WriterT (WriterT), runWriterT)+import           Data.Foldable                            (fold) import           Data.Lens.Light import qualified Data.Map                                 as Map-import           Data.Maybe import qualified Data.Set                                 as Set import           Language.Haskell.Exts.Annotated @@ -149,7 +148,7 @@ -- NB: this can be made more efficient resolveImportSpec mod isHiding syms spec =   case spec of-    IVar _ (NoNamespace {}) n ->+    IVar _ n ->       let         matches = mconcat $           -- Strictly speaking, the isConstructor check is unnecessary@@ -165,8 +164,7 @@           matches           spec     -- FIXME think about data families etc.-    IVar _ (TypeNamespace {}) _ -> error "'type' namespace is not supported yet" -- FIXME-    IAbs _ n+    IAbs _ _ n       | isHiding ->           -- This is a bit special. 'C' may match both types/classes and           -- data constructors.@@ -191,6 +189,7 @@               (ENotExported Nothing n mod)               matches               spec+    IAbs _ (TypeNamespace {}) _ -> error "'type' namespace is not supported yet" -- FIXME      -- FIXME     -- What about things like:

@@ -1,5 +1,6 @@ -- | This module is designed to be imported qualified. {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-} module Language.Haskell.Names.LocalSymbolTable   ( Table   , empty@@ -7,11 +8,11 @@   , addValue   ) where +import           Fay.Compiler.Prelude               hiding (empty) import           Language.Haskell.Names.SyntaxUtils import           Language.Haskell.Names.Types  import qualified Data.Map                           as Map-import           Data.Monoid import           Language.Haskell.Exts.Annotated  -- | Local symbol table — contains locally bound names

@@ -11,6 +11,7 @@ {-# LANGUAGE ImplicitParams        #-} {-# LANGUAGE KindSignatures        #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude     #-} {-# LANGUAGE OverlappingInstances  #-} {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE ScopedTypeVariables   #-}@@ -38,18 +39,15 @@   , lTable   ) where +import           Fay.Compiler.Prelude import           Language.Haskell.Names.GetBound import qualified Language.Haskell.Names.GlobalSymbolTable as Global import qualified Language.Haskell.Names.LocalSymbolTable  as Local import           Language.Haskell.Names.RecordWildcards -import           Control.Applicative import           Control.Monad.Identity import           Data.Generics.Traversable import           Data.Lens.Light-import           Data.List-import           Data.Monoid-import           Data.Typeable import           GHC.Exts                                 (Constraint) import           Language.Haskell.Exts.Annotated 

@@ -80,3 +80,5 @@ deriveGTraversable ''Overlap deriveGTraversable ''Sign deriveGTraversable ''Namespace+deriveGTraversable ''Role+deriveGTraversable ''PatternSynDirection

@@ -13,18 +13,15 @@ {-# LANGUAGE MonoLocalBinds        #-} module Language.Haskell.Names.Open.Instances () where +import           Fay.Compiler.Prelude import           Language.Haskell.Names.GetBound import           Language.Haskell.Names.Open.Base import           Language.Haskell.Names.Open.Derived    () import           Language.Haskell.Names.RecordWildcards import           Language.Haskell.Names.Types -import           Control.Applicative-import qualified Data.Data                              as D import           Data.Lens.Light-import           Data.List import qualified Data.Traversable                       as T-import           Data.Typeable import           Language.Haskell.Exts.Annotated  c :: Applicative w => c -> w c@@ -40,7 +37,7 @@ sc -: b = (b, sc) infix 5 -: -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Decl l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Decl l) where   rtraverse e sc =     case e of       -- N.B. We do not add pat to the local scope.@@ -68,10 +65,10 @@           <| sc       -: ty       _ -> defaultRtraverse e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Type l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Type l) where   rtraverse e sc = defaultRtraverse e (exprT sc) -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (DeclHead l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (DeclHead l) where   rtraverse e sc =     case e of       DHead l name ->@@ -85,7 +82,7 @@           <| binderT sc -: name       _ -> defaultRtraverse e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (ConDecl l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (ConDecl l) where   rtraverse e sc =     case e of       ConDecl l name tys ->@@ -106,7 +103,7 @@           <| sc -: fields  -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (FieldDecl l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (FieldDecl l) where   rtraverse e sc =     case e of       FieldDecl l name tys ->@@ -115,7 +112,7 @@           <| binderV sc -: name           <| sc -: tys -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Pat l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Pat l) where   rtraverse e sc =     case e of       PVar l name ->@@ -159,7 +156,7 @@           <| sc       -: pat       _ -> defaultRtraverse e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (PatField l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (PatField l) where   rtraverse e sc =     case e of       PFieldPat l qn pat ->@@ -183,7 +180,7 @@      , GetBound (a l) l      , Applicative w      , SrcInfo l-     , D.Data l+     , Data l      , ?alg :: Alg w)   => [a l] -> Scope -> (w [a l], Scope) chain pats sc =@@ -196,7 +193,7 @@         (ps', sc'') = chain ps sc'       in ((:) <$> p' <*> ps', sc'') -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Match l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Match l) where   rtraverse e sc =     case e of       Match l name pats rhs mbWhere ->@@ -222,7 +219,7 @@  -- NB: there is an inefficiency here (and in similar places), because we -- call intro on the same subtree several times. Maybe tackle it later.-instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Binds l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Binds l) where   rtraverse e sc =     case e of       BDecls l decls ->@@ -233,7 +230,7 @@           <| scWithBinds -: decls       _ -> defaultRtraverse e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Exp l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Exp l) where   rtraverse e sc =     case e of       Let l bnds body ->@@ -297,7 +294,7 @@        _ -> defaultRtraverse e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (Alt l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (Alt l) where   rtraverse e sc =     case e of       Alt l pat guardedAlts mbWhere ->@@ -311,7 +308,7 @@           <| scWithBinds -: guardedAlts           <| scWithBinds -: mbWhere -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (GuardedRhs l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (GuardedRhs l) where   rtraverse e sc =     case e of       GuardedRhs l stmts exp ->@@ -322,11 +319,11 @@           <*> stmts'           <|  scWithStmts -: exp -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable [Stmt l] where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable [Stmt l] where   rtraverse e sc =     fst $ chain e sc -instance (Resolvable l, SrcInfo l, D.Data l) => Resolvable (QualStmt l) where+instance (Resolvable l, SrcInfo l, Data l) => Resolvable (QualStmt l) where   rtraverse e sc =     case e of       QualStmt {} -> defaultRtraverse e sc

@@ -8,14 +8,12 @@   , sv_parent   ) where +import           Fay.Compiler.Prelude import qualified Language.Haskell.Names.GlobalSymbolTable as Global import           Language.Haskell.Names.SyntaxUtils import           Language.Haskell.Names.Types -import           Control.Applicative-import           Control.Arrow import           Data.Lens.Light-import           Data.Monoid import qualified Data.Set                                 as Set import           Language.Haskell.Exts.Annotated 

@@ -48,7 +48,7 @@ getModuleHead :: Module l -> ModuleHead l getModuleHead (Module _ (Just mh) _ _ _) = mh getModuleHead (XmlHybrid _ (Just mh) _ _ _ _ _ _ _) = mh-getModuleHead m = ModuleHead l (main_mod l) Nothing (Just (ExportSpecList l [EVar l (NoNamespace l) (UnQual l (Ident l "main"))]))+getModuleHead m = ModuleHead l (main_mod l) Nothing (Just (ExportSpecList l [EVar l (UnQual l (Ident l "main"))]))   where l = ann m  qNameToName :: QName l -> Name l

@@ -29,13 +29,11 @@   ) where  import {-# SOURCE #-} qualified Language.Haskell.Names.GlobalSymbolTable as Global+import           Fay.Compiler.Prelude -import           Data.Data import           Data.Foldable                            as F import           Data.Lens.Light-import           Data.Monoid import qualified Data.Set                                 as Set-import           Data.Traversable import           Language.Haskell.Exts.Annotated import           Text.Printf 

@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns #-} module Test.Desugar   ( tests   , devTest@@ -91,12 +92,17 @@  parseAndDesugar :: String -> String -> IO (Module SrcLoc, Either CompileError (Module SrcLoc)) parseAndDesugar name s =-  case parseFay "test" s :: ParseResult (Module SrcLoc) of+  case parseFay "test" s :: ParseResult (Module SrcSpanInfo) of     ParseFailed a b -> error $ show (name, a, b)-    ParseOk m -> do-      d <- desugar' "gen" noLoc m-      return (m,d)-+    ParseOk (fmap srcSpanInfoToSrcLoc -> m) -> do+      d <- desugar' "gen" noLoc $ m+      return (m, d)+  where+    srcSpanInfoToSrcLoc :: SrcSpanInfo -> SrcLoc+    srcSpanInfoToSrcLoc = (\ss -> SrcLoc { srcFilename = srcSpanFilename ss+                                         , srcLine     = srcSpanStartLine ss+                                         , srcColumn   = srcSpanStartColumn ss+                                         }) . srcInfoSpan doDesugar :: String -> String -> String -> Assertion doDesugar testName a b = do   (originalExpected, desugaredExpected, desugared) <- parseAndDesugarAll testName a b@@ -106,8 +112,8 @@  parseAndDesugarAll :: String -> String -> String -> IO (Module SrcLoc, Module SrcLoc, Module SrcLoc) parseAndDesugarAll testName a b = do-  (originalExpected',Right desugaredExpected) <- parseAndDesugar (testName ++ " expected")   a-  (_                ,Right desugared        ) <- parseAndDesugar (testName ++ " input") b+  (originalExpected',Right desugaredExpected) <- parseAndDesugar (testName ++ " expected") a+  (_                ,Right desugared        ) <- parseAndDesugar (testName ++ " input")    b   -- We need to desugar parens in the original module since we   -- strip it away in desugaring but there isn't alawys a way to construct   -- this paren directly from a source string

@@ -1,4 +1,5 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ViewPatterns      #-}  -- | Generate the web site/documentation for the Fay project. --@@ -7,8 +8,9 @@  module Main where -import           Fay import           Fay.Compiler.Prelude++import           Fay import qualified Test.CommandLine     as Cmd import qualified Test.Compile         as Compile import qualified Test.Convert         as Convert