Looking to integrate w/ hpack (#3)

* return list of program-stats pairs

* breaking apart env reading

* include generate types

* generation needs work

* benchmark uses new generation function

* can run on local files

* working on benchmark

* changed .gitignore in preparation to webapp (yesod) initial push

* initial yesod commit. Not fully integrated with hpack yet. Also, it does not call the tygar code yet

* loop came from recursive stat definition in pnsolver

* refactored types into the Types file

* removed completed TODO comment from Types file

* removed unused pragmas in Types file

* removed commented-out code

* benchmark works with more inputs

* works in parallel

* updated curated with full list

* add required files for benchmark

* removed webapp (temporarily)

* added webapp and modified global stack.yaml to be able to run it

* removed now unecessary package.yaml and stack.yaml inside of webapp

* table WIP

* call to synhtesize is almost stable. There is a pesky [Z3.Base.toBool: illegal Z3_bool value] error on OSX. Need to confirm if this happens on linux too

* use 3/4 of cores

* dockerfile and partial changes to search

* cleaning output

* output looks better

* remove old generate env function

* moved suite queries around

* added templates

* moved markup to templates and finally interfacing w/ tygar

* removing accidental push of emacs file

* newline at end of routes

* removed commented out pragma

* removed unecessary nested gitignore in webapp/

* changed tiers names to partial and total

* changed supportedModules to chosenModules, which is more descriptive

* removed unecessary typeclass derivations

* removed commented out imports

* removed more commented out code

* finally selecting modules

* removed redundant base dependency in package.yaml for webapp

* made form more question-like

.gitignore

@@ -31,3 +31,4 @@ tags
 .python-version
 .DS_Store
 HooglePlus.cabal
+webapp/static/tmp/*

dependencies/Dockerfile

@@ -0,0 +1,4 @@
+FROM ubuntu:16.04
+
+RUN apt-get update && apt-get install curl -y && libtinfo-dev -y && apt-get intall python -y && curl -sSL https://get.haskellstack.org/ | sh 
+# apt-get install z3

package.yaml

@@ -57,7 +57,8 @@ dependencies:
 - vector
 
 library:
-  source-dirs: src
+  source-dirs: 
+  - src
   other-extensions:
   - TemplateHaskell
   - Rank2Types
@@ -78,6 +79,20 @@ executables:
     - -O2
     dependencies:
     - HooglePlus
+  webapp:
+    main: Main.hs
+    source-dirs: 
+    - webapp/app
+    - webapp/src
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - HooglePlus
+    - yesod-core
+    - yesod-form
+    - shakespeare
   evaluation:
     main: Benchmark.hs
     source-dirs: benchmark

webapp/README.md

@@ -0,0 +1,33 @@
+> *Note: This project was generated from the `yesod-minimal` scaffolding, and does not support features like `yesod devel`. If you want these features, use the `yesod-simple` stack template.*
+
+## Haskell Setup
+
+1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
+	* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
+2. Install GHC: `stack setup`
+3. Build libraries: `stack build`
+
+## Development
+
+Start a development server with:
+
+```
+stack build --exec test-minimal
+```
+
+## Documentation
+
+* Read the [Yesod Book](https://www.yesodweb.com/book) online for free
+* Check [Stackage](http://stackage.org/) for documentation on the packages in your LTS Haskell version, or [search it using Hoogle](https://www.stackage.org/lts/hoogle?q=). Tip: Your LTS version is in your `stack.yaml` file.
+* For local documentation, use:
+	* `stack haddock --open` to generate Haddock documentation for your dependencies, and open that documentation in a browser
+	* `stack hoogle <function, module or type signature>` to generate a Hoogle database and search for your query
+* The [Yesod cookbook](https://github.com/yesodweb/yesod-cookbook) has sample code for various needs
+
+## Getting Help
+
+* Ask questions on [Stack Overflow, using the Yesod or Haskell tags](https://stackoverflow.com/questions/tagged/yesod+haskell)
+* Ask the [Yesod Google Group](https://groups.google.com/forum/#!forum/yesodweb)
+* There are several chatrooms you can ask for help:
+	* For IRC, try Freenode#yesod and Freenode#haskell
+	* [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels.

webapp/app/Main.hs

@@ -0,0 +1,6 @@
+import Application () -- for YesodDispatch instance
+import Foundation
+import Yesod.Core
+
+main :: IO ()
+main = warp 3000 App

webapp/routes

@@ -0,0 +1,3 @@
+/              HomeR GET
+/search        SearchR POST
+

webapp/src/Application.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE ViewPatterns         #-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Application where
+
+import Foundation
+import Yesod.Core
+
+import Home
+import Search
+
+mkYesodDispatch "App" resourcesApp

webapp/src/Foundation.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module Foundation where
+
+import Yesod.Core
+import Data.Text (Text)
+import Yesod.Form
+
+data App = App
+
+mkYesodData "App" $(parseRoutesFile "webapp/routes")
+
+instance Yesod App
+
+instance RenderMessage App FormMessage where
+    renderMessage :: App -> [Lang] -> FormMessage -> Text
+    renderMessage _ _ = defaultFormMessage

webapp/src/Home.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Home where
+
+import Foundation
+import Yesod.Core
+import Text.Lucius
+import Yesod.Form
+import Types
+import Data.Text (Text)
+import Control.Monad (filterM)
+
+tiers :: [(Text, Tier)]
+tiers = [("Partial", Partial), ("Total", Total)]
+
+getChosenModules :: [FormResult Bool] ->  FormResult [String]
+getChosenModules selection =
+    let allModules = ["Data.Int","Data.Bool", "Data.Maybe","Data.Either","Data.Tuple", "GHC.Char","Text.Show","Data.ByteString.Lazy","Data.ByteString.Builder"] in
+    let chosenModules' = filterM (\(s::([Char]),b::(FormResult Bool)) -> b) $ zip allModules selection in
+    let chosenModules = (map (\(s,b) -> s)) <$> chosenModules'
+    in chosenModules
+
+searchForm :: Html -> MForm Handler (FormResult TygarQuery, Widget)
+searchForm _ = do
+    (signatureRes, signatureView) <- mreq textField settings Nothing
+    (tierRes, tierView) <- mreq (radioFieldList tiers) defaultSettings Nothing
+    (dMaybeRes, dMaybeView) <- mreq checkBoxField defaultSettings Nothing
+    (dEitherRes, dEitherView) <- mreq checkBoxField defaultSettings Nothing
+    (dListRes, dListView) <- mreq checkBoxField defaultSettings Nothing
+    (tShowRes, tShowView) <- mreq checkBoxField defaultSettings Nothing
+    (gCharRes, gCharView) <- mreq checkBoxField defaultSettings Nothing
+    (dIntRes, dIntView) <- mreq checkBoxField defaultSettings Nothing
+    (dBSLazyRes, dBSLazyView) <- mreq checkBoxField defaultSettings Nothing
+    (dBSLazyBuilderRes, dBSLazyBuilderView) <- mreq checkBoxField defaultSettings Nothing
+
+    let selection = [dMaybeRes, dEitherRes, dListRes, tShowRes, gCharRes, dIntRes, dBSLazyRes, dBSLazyBuilderRes]
+    let chosenModules = getChosenModules selection 
+    let personRes = TygarQuery <$> signatureRes <*> chosenModules <*> tierRes
+    let widget = $(whamletFile "webapp/src/templates/form.hamlet")
+    return (personRes, widget)
+    where settings = defaultSettings {
+            fsAttrs   = [
+                ("class", "form-control"), 
+                ("placeholder", "Search by type singature!")
+                ]
+            }
+          defaultSettings = FieldSettings {
+            fsLabel   = "", 
+            fsTooltip = Nothing,
+            fsId      = Nothing,
+            fsName    = Nothing,
+            fsAttrs   = []
+          }
+
+
+getHomeR :: Handler Html
+getHomeR = do
+    ((_, formWidget), formEnctype) <- runFormGet searchForm
+    defaultLayout $ do
+        mcurrentRoute <- getCurrentRoute
+        let candidates = []::(String)
+        setTitle "TYGAR Demo - Home"
+        addScriptRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js"
+        addStylesheetRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css"
+        addStylesheetRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
+        toWidget $(luciusFile "webapp/src/templates/style.lucius")
+        $(whamletFile "webapp/src/templates/default.hamlet")

webapp/src/Search.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Search where
+
+import Foundation
+import Yesod.Core
+import Text.Lucius
+import Yesod.Form
+import Types
+import Data.Text (unpack)
+import Home
+import HooglePlus.Synthesize (synthesize, envToGoal)
+import Database.Environment (generateEnv)
+import Types.Experiments
+import Types.Generate
+import Types.Program (RProgram)
+
+runQuery :: TygarQuery -> IO [RProgram]
+runQuery queryOpts = do
+    env <- generateEnv options
+    goal <- envToGoal env (unpack $ typeSignature queryOpts)
+    (queryResults, _) <- fmap unzip $ synthesize defaultSearchParams goal
+    return queryResults
+    where options = defaultGenerationOpts {
+      modules = (chosenModules queryOpts),
+      pkgFetchOpts = Local {
+        files = ["libraries/tier1/base.txt", "libraries/tier1/bytestring.txt", "libraries/ghc-prim.txt"]
+        }
+    }
+
+postSearchR :: Handler Html
+postSearchR = do
+    ((res, formWidget), formEnctype) <- runFormPostNoToken searchForm
+    case res of
+        FormSuccess queryOpts -> defaultLayout $ do
+                            mcurrentRoute <- getCurrentRoute
+                            candidates <- liftIO $ runQuery queryOpts
+                            setTitle "TYGAR Demo | Search"
+                            addScriptRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js"
+                            addStylesheetRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css"
+                            addStylesheetRemote "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css"
+                            toWidget $(luciusFile "webapp/src/templates/style.lucius")
+                            $(whamletFile "webapp/src/templates/default.hamlet")
+        FormFailure err -> error (show err)
+        FormMissing  -> error "Form Missing. Please Resubmit"

webapp/src/Types.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+
+module Types where
+
+import Data.Text (Text)
+
+data Tier = Partial | Total
+    deriving (Show, Eq)
+
+data TygarQuery = TygarQuery
+    {
+      typeSignature :: Text,
+      chosenModules :: [String],
+      tier :: Tier
+    } deriving (Show)

webapp/src/templates/default.hamlet

@@ -0,0 +1,29 @@
+<main .container .main-style>
+    <h1 .hplus_font>
+        TYGAR
+    $if (Just HomeR == mcurrentRoute)
+        <br>
+        <h5>
+            Welcome to the TYGAR Demo
+        <p>
+            TYGAR (pronounced like tiger) is proof-of-concept tool aspiring to introduce new functionality in Haskell API search engines, most notably Hoogle.
+    <form method=post action=@{SearchR} enctype=#{formEnctype}>
+        ^{formWidget}
+
+    $if (Just HomeR /= mcurrentRoute)
+        <h5>
+            Results
+        <br>
+
+        $if null candidates
+            <p>
+            <b>
+                No results found.
+        $else
+            $forall candidate <- candidates
+                <code> 
+                    #{show candidate}
+<footer .footer .footer-style .text-center>
+    <div .container>
+        <span>
+            Made with blood, sweat, and tears by Zheng, David, Michael, Joe, Ranjit and Nadia.

webapp/src/templates/form.hamlet

@@ -0,0 +1,41 @@
+<p>
+    <b>
+        What modules to search on?
+<label .checkbox-inline>
+    ^{fvInput dMaybeView}
+        Data.Maybe
+<label .checkbox-inline>
+    ^{fvInput dEitherView}
+        Data.Either
+<label .checkbox-inline>
+    ^{fvInput dListView}
+        Data.List
+<label .checkbox-inline>
+    ^{fvInput tShowView}
+        Text.Show
+<label .checkbox-inline>
+    ^{fvInput gCharView}
+        GHC.Char
+<label .checkbox-inline>
+    ^{fvInput dIntView}
+        Data.Int
+<label .checkbox-inline>
+    ^{fvInput dBSLazyView}
+        Data.ByteString.Lazy
+<label .checkbox-inline>
+    ^{fvInput dBSLazyBuilderView}
+        Data.ByteString.Lazy.Builder
+<br>
+<br>
+<p>
+    <b>
+        Search only on totally defined functions or partial functions?
+<label class="radio-inline">
+    ^{fvInput tierView}
+<br>
+<br>
+^{fvInput signatureView}
+<br>
+<div id="search-button" .input-group-append>
+    <button .btn .btn-outline-secondary type="submit" id="button-addon2">
+        Search

webapp/src/templates/style.lucius

@@ -0,0 +1,21 @@
+.hplus_font{
+    font-family: 'Roboto Condensed', sans-serif;
+    color: #59057B;
+}
+
+main-style {
+    min-height: 90vh;
+}
+
+.footer-style{
+    color: white;
+    background-color: #1b3764;
+
+    display: flex;
+    align-items: center;
+
+    position: absolute;
+    bottom: 0;
+    min-height: 10vh;
+    width: 100%;
+}