Commit 84d50a9e authored by Kai-Oliver Prott's avatar Kai-Oliver Prott

Read currysource.css during compile-time

parent 92e6ad06
......@@ -45,6 +45,8 @@ Library
, containers
, curry-base == 1.2.0
, directory
, template-haskell >= 2.10 && < 3
, bytestring >= 0.10 && < 0.11
, extra >= 1.4.6
, filepath
, mtl
......@@ -105,6 +107,7 @@ Library
, Env.Value
, Exports
, Files.CymakePath
, Files.Embed
, Generators
, Generators.GenAbstractCurry
, Generators.GenFlatCurry
......@@ -145,6 +148,8 @@ Executable curry-frontend
, curry-base == 1.2.0
, curry-frontend
, directory
, template-haskell >= 2.10 && < 3
, bytestring >= 0.10 && < 0.11
, extra >= 1.4.6
, filepath
, mtl
......
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Files.Embed (embedDataFile, cssFileName) where
import Prelude (FilePath, Monad(..), ($), fromIntegral)
import Data.ByteString.Unsafe (unsafePackAddressLen)
import Data.ByteString (ByteString, unpack, length, readFile)
import System.IO.Unsafe (unsafePerformIO)
import Language.Haskell.TH.Syntax (Q, Exp(..), Lit(..), runIO)
import Paths_curry_frontend (getDataFileName)
-- | embed a file from the data dir within the code
embedDataFile :: FilePath -> Q Exp
embedDataFile fn = do
fp <- runIO $ getDataFileName fn
c <- runIO $ readFile fp
bsToExp c
bsToExp :: ByteString -> Q Exp
bsToExp bs =
return $ VarE 'unsafePerformIO
`AppE` (VarE 'unsafePackAddressLen
`AppE` LitE (IntegerL $ fromIntegral $ length bs)
`AppE` LitE (StringPrimL $ unpack bs))
cssFileName :: FilePath
cssFileName = "currysource.css"
......@@ -12,38 +12,39 @@
This module defines a function for generating HTML documentation pages
for Curry source modules.
-}
{-# LANGUAGE TemplateHaskell #-}
module Html.CurryHtml (source2html) where
import Prelude as P
import Control.Monad.Writer
import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, isJust)
import Data.ByteString as BS (ByteString, writeFile)
import Network.URI (escapeURIString, isUnreserved)
import System.Directory (copyFile, doesFileExist)
import System.FilePath ((</>))
import Curry.Base.Ident ( ModuleIdent (..), Ident (..), QualIdent (..)
, unqualify, moduleName)
import Curry.Base.Monad (CYIO, failMessages)
import Curry.Base.Monad (CYIO)
import Curry.Base.Position (Position)
import Curry.Base.Pretty ((<+>), text, vcat)
import Curry.Files.Filenames (htmlName)
import Curry.Syntax (Module (..), Token)
import Html.SyntaxColoring
import Base.Messages (message)
import Files.Embed
import CompilerOpts (Options (..))
import Paths_curry_frontend (getDataFileName)
-- |'FilePath' of the CSS style file to be added to the documentation.
cssFile :: FilePath
cssFile = "currysource.css"
-- |Read file via TemplateHaskell at compile time
cssContent :: ByteString
cssContent = $(embedDataFile cssFileName)
-- |Translate source file into HTML file with syntaxcoloring
source2html :: Options -> ModuleIdent -> [(Position, Token)] -> Module a
-> CYIO ()
source2html opts mid toks mdl = do
liftIO $ writeFile (outDir </> htmlName mid) doc
liftIO $ P.writeFile (outDir </> htmlName mid) doc
updateCSSFile outDir
where
doc = program2html mid (genProgram mdl toks)
......@@ -52,16 +53,8 @@ source2html opts mid toks mdl = do
-- |Update the CSS file
updateCSSFile :: FilePath -> CYIO ()
updateCSSFile dir = do
src <- liftIO $ getDataFileName cssFile
let target = dir </> cssFile
srcExists <- liftIO $ doesFileExist src
if srcExists then liftIO $ copyFile src target
else failMessages [message $ missingStyleFile src]
where
missingStyleFile f = vcat
[ text "Could not copy CSS style file:"
, text "File" <+> text ("`" ++ f ++ "'") <+> text "does not exist"
]
let target = dir </> cssFileName
liftIO $ BS.writeFile target cssContent
-- generates htmlcode with syntax highlighting
-- @param modulname
......@@ -75,7 +68,7 @@ program2html m codes = unlines
, "<meta charset=\"utf-8\" />"
, "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" />"
, "<title>" ++ titleHtml ++ "</title>"
, "<link rel=\"stylesheet\" href=\"" ++ cssFile ++ "\" />"
, "<link rel=\"stylesheet\" href=\"" ++ cssFileName ++ "\" />"
, "</head>"
, "<body>"
, "<table><tbody><tr>"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment