Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 3 commits
  • 13 files changed
  • 0 commit comments
  • 1 contributor
Commits on Mar 08, 2014
Alan Zimmerman Properly load targets using template haskell 4c23cb2
Commits on Mar 09, 2014
Alan Zimmerman load files with TH and QuasiQuotation 9dda4b6
Alan Zimmerman Sorting out construction of test environments cfd09fb
View
18 TODO.org
@@ -34,6 +34,24 @@
see http://parenz.wordpress.com/2013/07/23/on-custom-error-handlers-for-ghc-api/
** TODO elisp: cancel option is not implemented
** TODO renaming getPid in hroq mnesia removes HM. qualification in client file
+** DONE handle TH splices, e.g. renaming Queue.hs getSid to getServerPid
+
+ Refactoring failed: "allocExpr undefined for
+ (L {/home/alanz/mysrc/github/alanz/hroq/src/Data/Concurrent/Queue/Roq/DlqWorkers.hs:53:16-37}
+ (HsSpliceE
+ (HsSplice
+ (Unqual {OccName: splice})
+ (L {/home/alanz/mysrc/github/alanz/hroq/src/Data/Concurrent/Queue/Roq/DlqWorkers.hs:53:18-36}
+ (HsApp
+ (L {/home/alanz/mysrc/github/alanz/hroq/src/Data/Concurrent/Queue/Roq/DlqWorkers.hs:53:18-26}
+ (HsVar
+ (Unqual {OccName: mkClosure})))
+ (L {/home/alanz/mysrc/github/alanz/hroq/src/Data/Concurrent/Queue/Roq/DlqWorkers.hs:53:28-36}
+ (HsBracket
+ (VarBr
+ (True)
+ (Unqual {OccName: requeuer})))))))))"
+
** TODO from the source files
:PROPERTIES:
:ID: 2930a92b-9989-427f-b02e-e47ca11a84de
View
198 docker/HaRe-7.4.2/HaRe.cabal
@@ -1,198 +0,0 @@
-Name: HaRe
-Version: 0.7.1.3
-Author: Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman
-Maintainer: Alan Zimmerman
-Stability: Alpha
-Bug-Reports: http://github.com/alanz/HaRe/issues
-License: BSD3
-License-File: LICENSE
-Homepage: http://www.cs.kent.ac.uk/projects/refactor-fp
-Description:
- A Haskell 2010 refactoring tool. HaRe supports the full
- Haskell 2010 standard, through making use of the GHC API.
- .
- It is tested against GHC 7.4.x and 7.6.x (via travis-ci.org)
- .
- It currently only has emacs integration built in, community input
- welcome for others.
- .
- Warning: This is alpha code. Always commit code to your version
- control system before refactoring. The developers make no
- warranties, use at your own risk. May frighten children and dogs.
- .
- The renaming refactoring seems reasonably reliable.
- .
- Current known defects:
- .
- * liftToTopLevel of a recursive function may introduce parameter
- errors. e.g. lifting 'g' in the 'zmapQ' function from 'syz-0.2.0.0'
- 'Data.Generics.Zipper' results in the following
- .
- > zmapQ f z = reverse $ downQ [] g z where
- > g z' = query f z' : leftQ [] g z'
- .
- becomes
- .
- > zmapQ f z = reverse $ downQ [] (g f g)z
- >
- > g f z'g= query f z' : leftQ [] (g f g)g f g)z'
-
-Synopsis: the Haskell Refactorer.
-Category: Development, Refactoring
-Cabal-Version: >= 1.8
-Build-Type: Simple
-data-files: elisp/*.el
-data-Dir: .
-
-Library
- Build-Depends: base >= 4.0 && < 4.7
- , containers
- , directory
-
- , dual-tree
- , semigroups
- , monoid-extras
-
- , filepath
- , ghc
- , ghc-paths
- , ghc-prim
- , ghc-syb-utils
- , ghc-mod >= 3.1.6
- -- , lens
- , mtl
- , old-time
- , pretty
- , rosezipper
- , syb
- , hslogger
- , transformers
- , time
- , Strafunski-StrategyLib
- , syz
-
- GHC-Options: -Wall
-
- Hs-Source-Dirs: src
- -- Other-Modules: Paths_HaRe
- Exposed-modules:
- Language.Haskell.Refact.Case
- , Language.Haskell.Refact.DupDef
- , Language.Haskell.Refact.MoveDef
- , Language.Haskell.Refact.Renaming
- , Language.Haskell.Refact.SwapArgs
- , Language.Haskell.Refact.Utils
- , Language.Haskell.Refact.Utils.DualTree
- , Language.Haskell.Refact.Utils.GhcBugWorkArounds
- , Language.Haskell.Refact.Utils.GhcModuleGraph
- , Language.Haskell.Refact.Utils.GhcUtils
- , Language.Haskell.Refact.Utils.GhcVersionSpecific
- , Language.Haskell.Refact.Utils.Layout
- , Language.Haskell.Refact.Utils.LayoutTypes
- , Language.Haskell.Refact.Utils.LayoutUtils
- , Language.Haskell.Refact.Utils.LocUtils
- , Language.Haskell.Refact.Utils.Monad
- , Language.Haskell.Refact.Utils.MonadFunctions
- , Language.Haskell.Refact.Utils.RenamedSourceUtils
- , Language.Haskell.Refact.Utils.TokenUtils
- , Language.Haskell.Refact.Utils.TokenUtilsTypes
- , Language.Haskell.Refact.Utils.TypeSyn
- , Language.Haskell.Refact.Utils.TypeUtils
- , Paths_HaRe
- Extensions: CPP
-
-
-
-Executable ghc-hare
- Main-Is: MainHaRe.hs
- -- Other-Modules: Paths_HaRe
- GHC-Options: -Wall
- -- GHC-Options: -prof -fprof-auto -rtsopts -caf-all
- Hs-Source-Dirs:
- ./src
- Build-Depends: base >= 4.0 && < 4.7
- , array
- , containers
- , directory
-
- , dual-tree
- , semigroups
- , monoid-extras
-
- , filepath
- , ghc
- , ghc-paths
- , ghc-prim
- , ghc-syb-utils
- , ghc-mod >= 3.1.6
- -- , lens
- , mtl
- , old-time
- , parsec
- , pretty
- , rosezipper
- , syb
- , time
- , transformers
- , hslogger
- , Strafunski-StrategyLib
- , syz
- , HaRe >= 0.7.0.8
- Extensions: CPP
-
-
-test-suite spec
- type:
- exitcode-stdio-1.0
- ghc-options:
- -- reinstate these later -Wall
- -- -Wall
- -- reinstate these later -Werror
- -- -fhpc
- -- -fhpc -hpcdir dist/hpc/app-1.0
- cpp-options:
- -DTEST
- main-is:
- Spec.hs
- Hs-Source-Dirs:
- -- src
- test
- build-depends:
- base >= 4.0 && < 4.7
- , Diff >= 0.3.0
- , HUnit == 1.2.*
- , QuickCheck >= 2.5
- , containers
-
- , dual-tree
- , semigroups
- , monoid-extras
-
- , deepseq
- , directory
- , filepath
- , ghc >= 7.0.1 && < 7.8
- , ghc-paths == 0.1.*
- , ghc-prim
- , ghc-syb-utils
- , ghc-mod >= 3.1.6
- , hspec
- -- , hspec-discover
- , mtl
- , old-time
- , process
- , silently
- , stringbuilder
- , rosezipper
- , syb
- , transformers
- , time
- , hslogger
- , Strafunski-StrategyLib
- , syz
- , HaRe >= 0.7.0.8
- Extensions: CPP
-
-source-repository head
- type: git
- location: https://github.com/alanz/HaRe.git
View
26 docker/HaRe-7.6.3/Dockerfile
@@ -1,14 +1,30 @@
-FROM alanz/haskell-platform-2013.2.0.0-64
+FROM alanz/haskell-platform-2013.2-deb64
MAINTAINER alan.zimm@gmail.com
-ENV WD /opt/haskell
+ENV DEBIAN_FRONTEND noninteractive
-ADD HaRe.cabal /opt/haskell/HaRe.cabal
+#-----------------------------------------------------------------------
+# Install emacs and ssh server
+RUN echo "deb http://cdn.debian.net/debian/ testing main non-free contrib" >> /etc/apt/sources.list
+RUN apt-get update
+RUN apt-get -y dist-upgrade
+RUN apt-get -y install ssh openssh-server
+RUN apt-get -y install sudo
+RUN apt-get -y install git
+RUN apt-get -y install emacs24
-CMD cabal update
+# Copy the files into the container
+ADD . /src
-CMD cd WD && cabal install --only-dependencies
+RUN /src/setup.sh
+
+#RUN /src/startssh.sh
+
+# Expose the ssh port
+EXPOSE 22
+# Start shell and ssh services.
+CMD ["/bin/bash","/src/startssh.sh"]
# Note: to debug the partial build do the following
# docker run -i -t alanz/HaRe-7.6.3-64 /bin/bash
View
21 docker/HaRe-7.6.3/setup.sh
@@ -0,0 +1,21 @@
+#!/bin/bash
+
+# Create the directory needed to run the sshd daemon
+#mkdir /var/run/sshd
+
+# Add docker user and generate a random password with 12 characters that includes at least one capital letter and number.
+#DOCKER_PASSWORD=`pwgen -c -n -1 12`
+DOCKER_PASSWORD=password
+echo User: docker Password: $DOCKER_PASSWORD
+DOCKER_ENCRYPYTED_PASSWORD=`perl -e 'print crypt('"$DOCKER_PASSWORD"', "aa"),"\n"'`
+useradd -m -d /home/docker -p $DOCKER_ENCRYPYTED_PASSWORD docker
+sed -Ei 's/adm:x:4:/docker:x:4:docker/' /etc/group
+adduser docker sudo
+
+# Set the default shell as bash for docker user.
+chsh -s /bin/bash docker
+
+# Copy the config files into the docker directory
+#cd /src/config/ && sudo -u docker cp -R .[a-z]* [a-z]* /home/docker/
+
+echo "All done"
View
6 docker/HaRe-7.6.3/startssh.sh
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+#/etc/init.d/ssh start
+mkdir /var/run/sshd
+# Start the ssh service
+/usr/sbin/sshd -D
View
2  docker/dockerbuild-HaRe-7.4.2.sh
@@ -1,6 +1,6 @@
#!/bin/bash
-cp ../HaRe.cabal ./HaRe-7.4.2/
+#cp ../HaRe.cabal ./HaRe-7.4.2/
docker build -t alanz/HaRe-7.4.2-64 ./HaRe-7.4.2
View
2  docker/dockerbuild-HaRe-7.6.3.sh
@@ -1,6 +1,6 @@
#!/bin/bash
-cp ../HaRe.cabal ./HaRe-7.6.3/
+#cp ../HaRe.cabal ./HaRe-7.6.3/
docker build -t alanz/HaRe-7.6.3-64 ./HaRe-7.6.3
View
13 src/Language/Haskell/Refact/Utils/Layout.hs
@@ -253,8 +253,6 @@ allocDecls decls toks = r
(declLayout,tailToks) = foldl' doOne ([],toks) decls
r = strip $ declLayout ++ (makeLeafFromToks tailToks)
- -- r = error $ "allocDecls:tailToks=" ++ (show tailToks)
- -- r = error $ "allocDecls:declLayout=" ++ (show declLayout)
doOne :: ([LayoutTree],[PosToken]) -> GHC.LHsDecl GHC.RdrName -> ([LayoutTree],[PosToken])
doOne acc d@(GHC.L _ (GHC.TyClD _)) = allocTyClD acc d
@@ -940,7 +938,8 @@ allocExpr e@(GHC.L _ (GHC.ExprWithTySigOut _ _)) _ = error $ "allocExpr undefine
allocExpr e@(GHC.L _ (GHC.HsBracketOut _ _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0 e)
-allocExpr e@(GHC.L _ (GHC.HsSpliceE _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0 e)
+allocExpr (GHC.L _l (GHC.HsSpliceE (GHC.HsSplice _ expr))) toks = allocExpr expr toks
+
allocExpr e@(GHC.L _ (GHC.HsQuasiQuoteE _)) _ = error $ "allocExpr undefined for " ++ (SYB.showData SYB.Parser 0 e)
allocExpr (GHC.L l (GHC.HsProc p@(GHC.L lp _) cmd@(GHC.L lc _))) toks = r
@@ -1292,8 +1291,8 @@ allocSig (GHC.L l (GHC.SpecInstSig t)) toks = r
-- ---------------------------------------------------------------------
-allocRecField :: GHC.HsRecFields GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> [PosToken] -> [LayoutTree]
-allocRecField = error "Layout.allocRecField undefined"
+-- allocRecField :: GHC.HsRecFields GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> [PosToken] -> [LayoutTree]
+-- allocRecField = error "Layout.allocRecField undefined"
-- ---------------------------------------------------------------------
@@ -1541,8 +1540,8 @@ allocLFamInstDecl (GHC.L l (GHC.FamInstDecl n@(GHC.L ln _) (GHC.HsWB typs _ _) d
allocLTyClDecl = error "allocLTyClDecl undefined"
allocFunDep = error "allocFunDep undefined"
-allocHsTupArg :: GHC.HsTupArg GHC.RdrName -> [PosToken] -> [LayoutTree]
-allocHsTupArg = error "allocHsTupArg undefined"
+-- allocHsTupArg :: GHC.HsTupArg GHC.RdrName -> [PosToken] -> [LayoutTree]
+-- allocHsTupArg = error "allocHsTupArg undefined"
-- ---------------------------------------------------------------------
View
1  src/Language/Haskell/Refact/Utils/Monad.hs
@@ -286,6 +286,7 @@ loadModuleGraphGhc maybeTargetFiles = do
loadTarget :: [FilePath] -> RefactGhc ()
loadTarget targetFiles = do
setTargetFiles targetFiles
+ checkSlowAndSet
void $ GHC.load GHC.LoadAllTargets
-- ---------------------------------------------------------------------
View
2  src/Language/Haskell/Refact/Utils/TypeUtils.hs
@@ -1023,7 +1023,7 @@ hsFreeAndDeclaredGhc t = do
pat (GHC.NPlusKPat (GHC.L _ n) _ _ _) = return (FN [],DN [n])
pat _p@(GHC.SigPatIn (GHC.L _ p) b) = do
fdp <- pat p
- (FN fb,DN db) <- hsFreeAndDeclaredGhc b
+ (FN fb,DN _db) <- hsFreeAndDeclaredGhc b
-- logm $ "hsFreeAndDeclaredGhc.pat.SigPatIn:p=" ++ showGhc _p
-- logm $ "hsFreeAndDeclaredGhc.pat.SigPatIn:(fdp,(FN fb,DN db))=" ++ show (fdp,(FN fb,DN db))
#if __GLASGOW_HASKELL__ > 704
View
32 test/DualTreeSpec.hs
@@ -5,8 +5,8 @@ import Test.Hspec
import qualified GHC as GHC
--- import qualified GHC.SYB.Utils as SYB
--- import Data.Maybe
+import qualified GHC.SYB.Utils as SYB
+import Data.Maybe
import Language.Haskell.Refact.Utils.DualTree
import Language.Haskell.Refact.Utils.GhcBugWorkArounds
@@ -3476,5 +3476,33 @@ putToksAfterSpan test/testdata/AddParams1.hs:4:5:(((False,0,0,4),5),((False,0,0,
(renderSourceTree srcTree) `shouldBe` origSource
+ -- ---------------------------------
+
+ it "retrieves the tokens in SourceTree format TemplateHaskell" $ do
+ (t,toks) <- parsedFileGhc "./test/testdata/TH/Main.hs"
+ let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t
+
+ -- let renamed = fromJust $ GHC.tm_renamed_source t
+ -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""
+
+ let origSource = (GHC.showRichTokenStream $ bypassGHCBug7351 toks)
+
+ let layout = allocTokens parsed toks
+ (show $ retrieveTokens layout) `shouldBe` (show toks)
+ (invariant layout) `shouldBe` []
+
+{-
+ (drawTreeCompact layout) `shouldBe`
+ ""
+-}
+
+ let srcTree = layoutTreeToSourceTree layout
+ -- (showGhc srcTree) `shouldBe` ""
+
+ -- (show $ retrieveLines srcTree) `shouldBe` ""
+
+ (renderSourceTree srcTree) `shouldBe` origSource
+
+
-- -----------------------------------
View
27 test/testdata/TH/Main.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUGE QuasiQuotes #-}
+
+{- Main.hs -}
+module TH.Main where
+
+-- Import our template "pr"
+import TH.Printf
+
+-- The splice operator $ takes the Haskell source code
+-- generated at compile time by "pr" and splices it into
+-- the argument of "putStrLn".
+main = putStrLn ( $(pr "Hello") )
+
+-- import Control.Lens
+-- data Foo a = Foo { _fooArgs :: [String], _fooValue :: a }
+-- makeLenses ''Foo
+
+-- main = putStrLn "hello"
+
+-- longString = [str| hello |]
+
+
+baz = 'a'
+
+sillyString = [e|baz|]
+
View
50 test/testdata/TH/Printf.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{- Printf.hs -}
+module TH.Printf where
+
+-- Skeletal printf from the paper.
+-- It needs to be in a separate module to the one where
+-- you intend to use it.
+
+-- Import some Template Haskell syntax
+-- import Language.Haskell.THSyntax
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+import qualified Language.Haskell.TH as TH
+
+-- Describe a format string
+data Format = D | S | L String
+
+-- Parse a format string. This is left largely to you
+-- as we are here interested in building our first ever
+-- Template Haskell program and not in building printf.
+parse :: String -> [Format]
+parse s = [ L s ]
+
+-- Generate Haskell source code from a parsed representation
+-- of the format string. This code will be spliced into
+-- the module which calls "pr", at compile time.
+gen :: [Format] -> ExpQ
+gen [D] = [| \n -> show n |]
+gen [S] = [| \s -> s |]
+gen [L s] = stringE s
+
+-- Here we generate the Haskell code for the splice
+-- from an input format string.
+pr :: String -> ExpQ
+pr s = gen (parse s)
+
+-- str :: QuasiQuoter
+-- str = QuasiQuoter { quoteExp = stringE }
+
+silly :: QuasiQuoter
+silly = QuasiQuoter { quoteExp = \_ -> [| "yeah!!!" |] }
+
+silly2 :: QuasiQuoter
+silly2 = QuasiQuoter { quoteExp = \_ -> stringE "yeah!!!"
+ , quotePat = undefined
+ , quoteType = undefined
+ , quoteDec = undefined
+ }
+

No commit comments for this range

Something went wrong with that request. Please try again.