docgen as a preprocessor, fixes #193

.packcheck.ignore

@@ -17,7 +17,6 @@ hyperbole-oauth2/
 .gitignore
 .hlint.yaml
 .packcheck.ignore
-DOCTODO.md
 Dockerfile
 bin/dev
 bin/docgen

README.md

@@ -15,7 +15,7 @@ Create interactive HTML applications with type-safe serverside Haskell. Inspired
 module Main where
 
 import Data.Text (Text)
-import Web.Atomic.CSS
+import Web.Atomic.CSS (border, (~))
 import Web.Hyperbole
 
 main :: IO ()
@@ -78,6 +78,7 @@ Add hyperbole and text as dependencies to the `.cabal` file:
     build-depends:
         base
       , hyperbole
+      , atomic-css
       , text
 
     default-language: GHC2021
@@ -97,8 +98,8 @@ Learn More
 <!--     <img src="https://github.com/seanhess/hyperbole/raw/main/docs/hackage.svg"> -->
 <!-- </a> -->
 
-* [Local Development](./docs/dev.md)
 * [Comparison with Similar Frameworks](./docs/comparison.md)
+* [Local Development](./docs/dev.md)
 * [Using NIX](./docs/nix.md)
 
 In the Wild

cabal.project

@@ -3,5 +3,4 @@ multi-repl: True
 packages:
   .
   ./demo/
-  ./docs/
   ./hyperbole-oauth2/

docs/Main.hs → docs/Docgen.hs

@@ -1,31 +1,26 @@
-{-# LANGUAGE QuasiQuotes #-}
-
 module Main where
 
-import Control.Exception (SomeException, try)
 import Data.Char (isAlpha, isSpace)
 import Data.String.Conversions (cs)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
-import Distribution.Simple.Utils (copyDirectoryRecursive)
-import Distribution.Verbosity (verbose)
 import System.Directory
+import System.Environment (getArgs)
 import System.FilePath
-import Web.Hyperbole.Data.URI
-
 
--- import Control.Applicative ((<|>))
--- import Web.Hyperbole.Route (matchRoute)
 
 main :: IO ()
 main = do
-  let tmpDir = "/tmp/hyperbole"
-  copyExtraFilesTo tmpDir
-  expandSourcesTo tmpDir
-  putStrLn $ "COPY RECURSIVE: " <> (tmpDir <> "docs")
-  copyDirectoryRecursive verbose "./docs" (tmpDir </> "docs")
-  copyDirectoryRecursive verbose "./demo" (tmpDir </> "demo")
+  args <- getArgs
+  case args of
+    [original, input, output] -> do
+      src <- readSource input
+      expanded <- expandFile src
+      let linePragma = T.pack $ "{-# LINE 1 \"" ++ original ++ "\" #-}"
+      let final = SourceCode [linePragma] <> expanded
+      T.writeFile output $ T.unlines final.lines
+    _ -> error "Usage (Hyperbole Internal Only): docgen src/MyModule.hs /tmp/input/MyModule.hs /build/output/Original.hs"
 
 
 test :: IO ()
@@ -35,35 +30,32 @@ test = do
   mapM_ print lns
 
 
-expandSourcesTo :: FilePath -> IO ()
-expandSourcesTo tmpDir = do
-  allFiles <- relativeSourceFiles "./src"
-  -- mapM_ (putStrLn . ("SOURCE " <>)) allFiles
-  mapM_ (expandAndCopyFileTo tmpDir) allFiles
-
-
-copyExtraFilesTo :: FilePath -> IO ()
-copyExtraFilesTo tmpDir = do
-  createDirectoryIfMissing True tmpDir
-  copyFile "./cabal.project" (tmpDir </> "cabal.project")
-  copyFile "./hyperbole.cabal" (tmpDir </> "hyperbole.cabal")
-  copyFile "./README.md" (tmpDir </> "README.md")
-  copyFile "./CHANGELOG.md" (tmpDir </> "CHANGELOG.md")
-  copyFile "./LICENSE" (tmpDir </> "LICENSE")
-  createDirectoryIfMissing True (tmpDir </> "client/dist")
-  copyFile "./client/dist/hyperbole.js" (tmpDir </> "client/dist/hyperbole.js")
-  copyFile "./client/dist/hyperbole.js.map" (tmpDir </> "client/dist/hyperbole.js.map")
-  createDirectoryIfMissing True (tmpDir </> "client/util")
-  copyFile "./client/util/live-reload.js" (tmpDir </> "client/util/live-reload.js")
-
-
-expandAndCopyFileTo :: FilePath -> FilePath -> IO ()
-expandAndCopyFileTo tmpDir pth = do
-  putStrLn $ "EXPANDING " <> pth
-  src <- readSource pth
-  expanded <- expandFile src
-  writeSource tmpDir pth expanded
-
+-- expandSourcesTo :: FilePath -> IO ()
+-- expandSourcesTo tmpDir = do
+--   allFiles <- relativeSourceFiles "./src"
+--   -- mapM_ (putStrLn . ("SOURCE " <>)) allFiles
+--   mapM_ (expandAndCopyFileTo tmpDir) allFiles
+
+-- copyExtraFilesTo :: FilePath -> IO ()
+-- copyExtraFilesTo tmpDir = do
+--   createDirectoryIfMissing True tmpDir
+--   copyFile "./cabal.project" (tmpDir </> "cabal.project")
+--   copyFile "./hyperbole.cabal" (tmpDir </> "hyperbole.cabal")
+--   copyFile "./README.md" (tmpDir </> "README.md")
+--   copyFile "./CHANGELOG.md" (tmpDir </> "CHANGELOG.md")
+--   copyFile "./LICENSE" (tmpDir </> "LICENSE")
+--   createDirectoryIfMissing True (tmpDir </> "client/dist")
+--   copyFile "./client/dist/hyperbole.js" (tmpDir </> "client/dist/hyperbole.js")
+--   copyFile "./client/dist/hyperbole.js.map" (tmpDir </> "client/dist/hyperbole.js.map")
+--   createDirectoryIfMissing True (tmpDir </> "client/util")
+--   copyFile "./client/util/live-reload.js" (tmpDir </> "client/util/live-reload.js")
+
+-- expandAndCopyFileTo :: FilePath -> FilePath -> IO ()
+-- expandAndCopyFileTo tmpDir pth = do
+--   putStrLn $ "EXPANDING " <> pth
+--   src <- readSource pth
+--   expanded <- expandFile src
+--   writeSource tmpDir pth expanded
 
 readSource :: FilePath -> IO SourceCode
 readSource pth = do
@@ -82,27 +74,26 @@ writeSource tmpDir relPath src = do
     dropWhile (== '/') . dropWhile (== '.')
 
 
-relativeSourceFiles :: FilePath -> IO [FilePath]
-relativeSourceFiles dir = do
-  contents <- tryDirectory dir
-  let folders = filter isFolder contents
-  let files = filter isSourceFile contents
-
-  files' <- mapM (relativeSourceFiles . addDir) folders
-
-  pure $ fmap addDir files <> mconcat files'
- where
-  isSourceFile pth = takeExtension pth == ".hs"
-  isFolder pth = takeExtension pth == ""
-  addDir = (dir </>)
-  tryDirectory pth = do
-    res <- try $ listDirectory pth
-    case res of
-      Left (_ :: SomeException) -> do
-        putStrLn $ "SKIPPED" <> pth
-        pure []
-      Right files -> pure files
-
+-- relativeSourceFiles :: FilePath -> IO [FilePath]
+-- relativeSourceFiles dir = do
+--   contents <- tryDirectory dir
+--   let folders = filter isFolder contents
+--   let files = filter isSourceFile contents
+--
+--   files' <- mapM (relativeSourceFiles . addDir) folders
+--
+--   pure $ fmap addDir files <> mconcat files'
+--  where
+--   isSourceFile pth = takeExtension pth == ".hs"
+--   isFolder pth = takeExtension pth == ""
+--   addDir = (dir </>)
+--   tryDirectory pth = do
+--     res <- try $ listDirectory pth
+--     case res of
+--       Left (_ :: SomeException) -> do
+--         putStrLn $ "SKIPPED" <> pth
+--         pure []
+--       Right files -> pure files
 
 data Macro
   = Embed
@@ -111,6 +102,7 @@ data Macro
   }
   deriving (Eq)
 newtype SourceCode = SourceCode {lines :: [Text]}
+  deriving newtype (Monoid, Semigroup)
 instance Show Macro where
   -- show (Example p) = "Example " <> show p
   show (Embed mn def) = "Embed " <> show mn <> " " <> show def
@@ -180,9 +172,8 @@ expandLine line = do
 --       Nothing -> fail $ "Could not find example: " <> cs (pathToText False p)
 --       Just r -> pure r
 
-exampleBaseURI :: URI
-exampleBaseURI = [uri|https://hyperbole.live|]
-
+-- exampleBaseURI :: URI
+-- exampleBaseURI = [uri|https://hyperbole.live|]
 
 modulePath :: ModuleName -> FilePath
 modulePath (ModuleName mn) = cs $ T.replace "." "/" mn <> ".hs"
@@ -191,7 +182,7 @@ modulePath (ModuleName mn) = cs $ T.replace "." "/" mn <> ".hs"
 expandEmbed :: ModuleName -> Text -> TopLevelDefinition -> IO [Text]
 expandEmbed mn pfx def = do
   let src = modulePath mn
-  putStrLn $ "  embed: " <> src
+  -- putStrLn $ "  embed: " <> src
   source <- T.readFile $ "./demo/" <> src
   expanded <- requireTopLevel def (SourceCode $ T.lines source)
   pure $ fmap markupLine expanded

docs/dev.md

@@ -1,6 +1,9 @@
 Local Development
 =================
 
+
+# JavaScript Client Development
+
 Download and install [NPM](https://nodejs.org/en/download). On a mac, can be installed via homebrew:
 
 ```sh
@@ -38,11 +41,12 @@ cd client
 npm run dev
 ```
 
-Run examples
+
+# Haskell Server Development
+
+Run demo locally. Then visit 
 
 ```
-# demo needs to have demo/static and client/dist as relative paths
-cd <your-path-to>/hyperbole
 cabal run demo
 ```
 
@@ -80,8 +84,16 @@ cabal test
 
 ### File watching
 
-Run tests, then recompile everything on file change and restart examples
+Run tests, then recompile both client and server on file change, then restart demo
 
 ```
 bin/dev
 ```
+
+### Haskell Language Server
+
+We use a custom preprocessor to embed compiler-checked examples into Haddock. Everything is automatic with Cabal, but HLS doesn't support it yet. Run this command to get HLS working:
+
+```
+cabal install docgen:docgen --overwrite-policy=always
+```