├── .dir-locals.el
├── .gitignore
├── LICENSE
├── README.md
├── app
    └── Main.hs
├── dev.sh
├── stack.yaml
├── webshow.cabal
└── webshow.css


/.dir-locals.el:
--------------------------------------------------------------------------------
1 | ;;; Directory Local Variables
2 | ;;; For more information see (info "(emacs) Directory Variables")
3 | 
4 | ((haskell-mode
5 |   (intero-targets "webshow:exe:webshow")))
6 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | .stack-work
2 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright Chris Done (c) 2019
 2 | 
 3 | All rights reserved.
 4 | 
 5 | Redistribution and use in source and binary forms, with or without
 6 | modification, are permitted provided that the following conditions are met:
 7 | 
 8 |     * Redistributions of source code must retain the above copyright
 9 |       notice, this list of conditions and the following disclaimer.
10 | 
11 |     * Redistributions in binary form must reproduce the above
12 |       copyright notice, this list of conditions and the following
13 |       disclaimer in the documentation and/or other materials provided
14 |       with the distribution.
15 | 
16 |     * Neither the name of Chris Done nor the names of other
17 |       contributors may be used to endorse or promote products derived
18 |       from this software without specific prior written permission.
19 | 
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # webshow
 2 | 
 3 | Run `webshow` of a directory and get pretty browsing of the data structure.
 4 | 
 5 | ## Usage
 6 | 
 7 | Supports only Haskell `Show` values at the moment.
 8 | 
 9 | ```
10 | Usage: webshow [--version] [--help] [-p|--port ARG] [-d|--directory ARG]
11 |   Show printed output from languages
12 | 
13 | Available options:
14 |   --version                Show version
15 |   --help                   Show this help text
16 |   -p,--port ARG            Port number to listen on
17 |   -d,--directory ARG       Directory to look at
18 | ```
19 | 
20 | E.g.
21 | 
22 | ```
23 | $ webshow -d /my/path -p 1234
24 | ```
25 | Put a file like `[1,2,3]` in `x.hs` in the `/my/path` directory and then browse to it.
26 | 
27 | In my case I've made a dir `/webshow` and then when I want to view something I do
28 | 
29 | ```haskell
30 | writeFile "/webshow/thing.hs" (show thing)
31 | ```
32 | 
33 | And then go to `http://localhost:1234/thing.hs`.
34 | 
35 | ## Example
36 | 
37 | You click the constructor names or parentheses or list brackets to expand/collapse them interactively, like web browser's consoles that view JS objects.
38 | 
39 | [Video](https://imgur.com/a/jwuxsIg)
40 | 
41 | High-res screenshot:
42 | 
43 | <img src="https://i.imgur.com/ZnO5wBp.png">
44 | 
45 | ## How it works
46 | 
47 | It uses Haskell's `pretty-show` to parse your Haskell `Show` output. So use types that have reasonable output. If you wrote a custom Show instance, it'll just show the text as plain text.
48 | 


--------------------------------------------------------------------------------
/app/Main.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE FlexibleContexts #-}
  2 | {-# LANGUAGE TemplateHaskell #-}
  3 | {-# LANGUAGE TypeApplications #-}
  4 | {-# LANGUAGE LambdaCase #-}
  5 | {-# LANGUAGE OverloadedStrings #-}
  6 | 
  7 | import           Control.Monad
  8 | import           Control.Monad.State
  9 | import           Data.FileEmbed
 10 | import           Data.Maybe
 11 | import           Data.String
 12 | import qualified Data.Text as T
 13 | import qualified Data.Text.Encoding as T
 14 | import qualified Data.Text.IO as T
 15 | import           Language.Haskell.HsColour.CSS
 16 | import           Lucid
 17 | import           Lucid.Base
 18 | import           Network.HTTP.Types
 19 | import           Network.Wai
 20 | import           Network.Wai.Handler.Warp (run)
 21 | import           Options.Applicative
 22 | import           Options.Applicative.Simple
 23 | import           System.Directory
 24 | import           System.FilePath
 25 | import           Text.Show.Pretty (Value(..), parseValue)
 26 | 
 27 | data Opts =
 28 |   Opts
 29 |     { optsPort :: Int
 30 |     , optsDir :: FilePath
 31 |     } deriving (Show)
 32 | 
 33 | app :: FilePath -> Application
 34 | app dir req respond = do
 35 |   case pathInfo req of
 36 |     [fp] -> do
 37 |       contents <- readFile (dir <> "/" <> (T.unpack fp))
 38 |       case lookup (takeExtension (T.unpack fp)) supported of
 39 |         Nothing ->
 40 |           reply
 41 |             (html_
 42 |                (body_
 43 |                   (do p_ (small_ "(Unknown file type. Display as plain text.)")
 44 |                       pre_ (toHtml contents))))
 45 |         Just generate ->
 46 |           do stylesheet <- getStylesheet
 47 |              reply
 48 |                (html_
 49 |                   (do head_ (style_ stylesheet)
 50 |                       body_ (generate contents)))
 51 |     _ -> do
 52 |       files <-
 53 |         fmap
 54 |           (filter (isJust . flip lookup supported . takeExtension) .
 55 |            filter (not . all (== '.')))
 56 |           (getDirectoryContents dir)
 57 |       reply
 58 |         (html_
 59 |            (body_
 60 |               (do p_
 61 |                     (do "Renderable files in "
 62 |                         code_ (toHtml dir))
 63 |                   ul_
 64 |                     (mapM_
 65 |                        (\file ->
 66 |                           li_
 67 |                             (a_ [href_ (fromString ("/" ++ file))] (toHtml file)))
 68 |                        files))))
 69 |   where
 70 |     reply html =
 71 |       respond
 72 |         (responseLBS status200 [("Content-Type", "text/html")] (renderBS html))
 73 | 
 74 | getStylesheet :: IO T.Text
 75 | getStylesheet =
 76 |   if dev
 77 |     then T.readFile "webshow.css"
 78 |     else pure (T.decodeUtf8 $(embedFile "webshow.css"))
 79 |   where
 80 |     dev = True
 81 | 
 82 | supported :: [(String, String -> Html ())]
 83 | supported =
 84 |   [ ( ".hs"
 85 |     , \contents ->
 86 |         case parseValue contents of
 87 |           Just val -> evalState (commuteHtmlT (valueToHtml val)) 0
 88 |           Nothing -> do
 89 |             p_
 90 |               (small_
 91 |                  "(Invalid Haskell Show value. Displaying as Haskell source.)")
 92 |             pre_ (toHtmlRaw (hscolour False 0 contents)))
 93 |   ]
 94 | 
 95 | main :: IO ()
 96 | main = do
 97 |   (opts, ()) <-
 98 |     simpleOptions
 99 |       "1.0"
100 |       "Webshow"
101 |       "Show printed output from languages"
102 |       (Opts <$>
103 |        option auto (long "port" <> short 'p' <> help "Port number to listen on" <> value 3333) <*>
104 |        strOption (long "directory" <> short 'd' <> help "Directory to look at" <> value "."))
105 |       empty
106 |   putStrLn ("Listening on http://localhost:" ++ show @Int (optsPort opts))
107 |   run (optsPort opts) (app (optsDir opts))
108 | 
109 | valueToHtml :: MonadState Int m => Value -> HtmlT m ()
110 | valueToHtml =
111 |   \case
112 |     String string -> block "string" (toHtml string)
113 |     Char char -> block "char" (toHtml char)
114 |     Float float -> block "float" (toHtml float)
115 |     Integer integer -> block "integer" (toHtml integer)
116 |     Ratio n d ->
117 |       block
118 |         "ratio"
119 |         (do valueToHtml n
120 |             "/"
121 |             valueToHtml d)
122 |     Neg n ->
123 |       block
124 |         "neg"
125 |         (do "-"
126 |             valueToHtml n)
127 |     List xs ->
128 |       togglable
129 |         "list"
130 |         (\button -> do
131 |            let button' =
132 |                  if null xs
133 |                    then id
134 |                    else button
135 |            button' (inline "brace" "[")
136 |            unless
137 |              (null xs)
138 |              (do button'
139 |                    (inline
140 |                       "preview"
141 |                       (toHtml
142 |                          (show (length xs) ++
143 |                           " item" ++
144 |                           if length xs == 1
145 |                             then ""
146 |                             else "s")))
147 |                  block
148 |                    "contents"
149 |                    (table_
150 |                       (mapM_
151 |                          (\(i, e) ->
152 |                             tr_
153 |                               (do td_
154 |                                     [class_ "field-comma-td"]
155 |                                     (if i > 0
156 |                                        then ", "
157 |                                        else "")
158 |                                   td_ [class_ "field-value-td"] (valueToHtml e)))
159 |                          (zip [0 :: Int ..] xs))))
160 |            button' (inline "brace" "]"))
161 |     Con name xs ->
162 |       togglable
163 |         "con"
164 |         (\button -> do
165 |            when (not (null xs)) (inline "brace" "(")
166 |            (if null xs
167 |               then id
168 |               else button)
169 |              (inline "con-name" (toHtml name))
170 |            block "contents" (mapM_ (\e -> block "con-slot" (valueToHtml e)) xs)
171 |            when (not (null xs)) (inline "brace" ")"))
172 |     Tuple xs ->
173 |       block
174 |         "tuple"
175 |         (do when (not (null xs)) (inline "brace" "(")
176 |             block
177 |               "contents"
178 |               (table_
179 |                  (mapM_
180 |                     (\(i, e) ->
181 |                        tr_
182 |                          (do td_
183 |                                [class_ "field-comma-td"]
184 |                                (if i > 0
185 |                                   then ", "
186 |                                   else "")
187 |                              td_ [class_ "field-value-td"] (valueToHtml e)))
188 |                     (zip [0 :: Int ..] xs)))
189 |             when (not (null xs)) (inline "brace" ")"))
190 |     InfixCons {} -> block "infix-con" "TODO: infix"
191 |     Rec name xs ->
192 |       togglable
193 |         "rec"
194 |         (\button -> do
195 |            when (not (null xs)) (inline "brace" "(")
196 |            button (inline "con-name" (toHtml name))
197 |            inline "brace open-brace" "{"
198 |            block
199 |              "contents"
200 |              (table_
201 |                 (mapM_
202 |                    (\(i, (n, e)) ->
203 |                       tr_
204 |                         (do td_
205 |                               [class_ "field-comma-td"]
206 |                               (if i > 0
207 |                                  then ", "
208 |                                  else "")
209 |                             td_
210 |                               [class_ "field-name-td"]
211 |                               (inline "field-name" (toHtml n))
212 |                             td_ [class_ "field-equals-td"] (inline "equals" "=")
213 |                             td_ [class_ "field-value-td"] (valueToHtml e)))
214 |                    (zip [0 :: Int ..] xs)))
215 |            inline "brace" "}"
216 |            when (not (null xs)) (inline "brace" ")"))
217 |   where
218 |     inline name inner = span_ [class_ name] inner
219 |     block name inner = div_ [class_ name] inner
220 |     togglable cls inner = do
221 |       uuid <- fmap (T.pack . show) get
222 |       modify (+ 1)
223 |       div_
224 |         [class_ ("toggle " <> cls)]
225 |         (do input_ [type_ "checkbox", class_ "check", id_ uuid]
226 |             div_ [class_ "inner"] (inner (\html -> label_ [for_ uuid] html)))
227 | 
228 | isSimple :: Value -> Bool
229 | isSimple =
230 |   \case
231 |     String {} -> True
232 |     Char {} -> True
233 |     Float {} -> True
234 |     Integer {} -> True
235 |     Ratio {} -> True
236 |     Neg {} -> True
237 |     List [] -> True
238 |     Con _ [] -> True
239 |     Tuple [] -> True
240 |     Rec _ [] -> True
241 |     _ -> False
242 | 


--------------------------------------------------------------------------------
/dev.sh:
--------------------------------------------------------------------------------
1 | stack build --file-watch --exec 'cron-daemon webshow --stderr /dev/null --stdout /dev/null --pid .stack-work/cron-daemon-pid --terminate -- -d /webshow' --fast
2 | 


--------------------------------------------------------------------------------
/stack.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-12.12
2 | 


--------------------------------------------------------------------------------
/webshow.cabal:
--------------------------------------------------------------------------------
 1 | name:                webshow
 2 | version:             0.0.0
 3 | synopsis:            Show programming language printed values in a web UI
 4 | description:         Show programming language printed values in a web UI. Supports Haskell Show values only at the moment.
 5 | homepage:            https://github.com/chrisdone/webshow#readme
 6 | license:             BSD3
 7 | license-file:        LICENSE
 8 | author:              Author name here
 9 | maintainer:          example@example.com
10 | copyright:           2019 Author name here
11 | category:            Web
12 | build-type:          Simple
13 | extra-source-files:  README.md
14 | cabal-version:       >=1.10
15 | 
16 | executable webshow
17 |   hs-source-dirs:      app
18 |   main-is:             Main.hs
19 |   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N
20 |   build-depends:       base >=4.7 && <5
21 |                      , warp
22 |                      , wai
23 |                      , http-types
24 |                      , pretty-show
25 |                      , directory
26 |                      , optparse-simple
27 |                      , optparse-applicative
28 |                      , lucid
29 |                      , hscolour
30 |                      , filepath
31 |                      , text
32 |                      , file-embed
33 |                      , mtl
34 |   default-language:    Haskell2010
35 | 
36 | source-repository head
37 |   type:     git
38 |   location: https://github.com/chrisdone/webshow
39 | 


--------------------------------------------------------------------------------
/webshow.css:
--------------------------------------------------------------------------------
 1 | body {
 2 |   font-family: monospace;
 3 | }
 4 | 
 5 | pre {
 6 |   white-space: pre-wrap;       /* css-3 */
 7 |   white-space: -moz-pre-wrap;  /* Mozilla, since 1999 */
 8 |   white-space: -pre-wrap;      /* Opera 4-6 */
 9 |   white-space: -o-pre-wrap;    /* Opera 7 */
10 |   word-wrap: break-word;       /* Internet Explorer 5.5+ */
11 | }
12 | 
13 | .contents {
14 |   padding: 0.1em 0.1em 0.1em 1em;
15 | }
16 | 
17 | .equals { margin-left: 1em; margin-right: 1em }
18 | 
19 | td.field-name-td, td.field-equals-td, td.field-comma-td {
20 |   vertical-align: top;
21 | }
22 | 
23 | .toggle > .check {
24 |   display: none;
25 | }
26 | 
27 | span.brace {
28 |   color: #666;
29 | }
30 | 
31 | span.open-brace { margin-left: 0.5em; }
32 | 
33 | span.con-name {
34 |   color: #22863a;
35 |   border-radius: 3px;
36 | }
37 | 
38 | .con-name, .brace {
39 |   cursor: default;
40 | }
41 | 
42 | span.integer {
43 |   color: #005cc5;
44 | }
45 | 
46 | .toggle .check + .inner > .contents {
47 |   display: none
48 | }
49 | 
50 | .toggle .check:checked + .inner > .contents {
51 |   display: block;
52 | }
53 | 
54 | .toggle .check:checked + .inner > label > .preview {
55 |   display: none;
56 | }
57 | 
58 | .toggle { display: flex; }
59 | 
60 | .inner:hover > .brace {
61 |   background: #e1f6ee;
62 |   color: green;
63 | }
64 | 
65 | label:hover * {
66 |   background: #3da491;
67 |   color: white;
68 |   cursor: pointer;
69 | }
70 | 
71 | label > span:empty::after {
72 |     content: "_"
73 | }
74 | 


--------------------------------------------------------------------------------