~ubuntu-branches/ubuntu/raring/agda/raring-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Interaction/Highlighting/HTML.hs

  • Committer: Bazaar Package Importer
  • Author(s): Iain Lane
  • Date: 2010-01-05 23:43:20 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20100105234320-6ksc0sdsfhtweknu
Tags: 2.2.6-1
* New upstream release 2.2.6, for headlines please see:
  http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Main.Version-2-2-6
* debian/control
  + Bump standards-version to 3.8.3, no changes
  + Fix Vcs-Git to point to correct URL
  + Update build-depends for new upstream release
  + Undo arch/indep split per current pkg-haskell practice
  + Add Homepage field
* debian/copyright: Fix encoding to UTF-8 (thanks Lintian) 
* debian/README.source: Remove, no repacking so not necessary any more 
* debian/50agda.el:
  + Only load file if it exists, prevents a non-intrusive emacs warning
    where 50agda.el is left on system when package is removed. 
    (Closes: #559197). 
  + Do not load file on XEmacs — agda-mode is not compatible with XEmacs.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
{-# LANGUAGE CPP #-}
 
2
 
1
3
-- | Function for generating highlighted, hyperlinked HTML from Agda
2
4
-- sources.
3
5
 
8
10
import Control.Applicative
9
11
import Control.Monad
10
12
import Control.Monad.Trans
 
13
import Control.Monad.State.Class
11
14
import Control.Arrow ((***))
12
15
import System.FilePath
13
16
import System.Directory
17
20
import Data.Maybe
18
21
import qualified Data.Map  as Map
19
22
import qualified Data.List as List
20
 
import qualified Agda.Utils.IO as UTF8
21
23
 
22
24
import Paths_Agda
23
25
 
 
26
import Agda.Interaction.FindFile
24
27
import Agda.Interaction.Highlighting.Generate
25
28
import Agda.Interaction.Highlighting.Precise
26
29
import Agda.Interaction.Highlighting.Range
27
 
import qualified Agda.Interaction.Imports as Imp
28
30
import Agda.TypeChecking.Monad (TCM)
29
31
import qualified Agda.TypeChecking.Monad as TCM
30
32
import qualified Agda.Syntax.Abstract as A
 
33
import qualified Agda.Syntax.Concrete as C
31
34
import Agda.Syntax.Common
32
35
import qualified Agda.Syntax.Scope.Monad as Scope
33
36
import Agda.Syntax.Translation.ConcreteToAbstract
34
37
import Agda.Interaction.Options
 
38
import Agda.Utils.FileName (filePath)
 
39
import qualified Agda.Utils.IO.UTF8 as UTF8
 
40
import Agda.Utils.Pretty
 
41
 
 
42
import Agda.Utils.Impossible
 
43
#include "../../undefined.h"
35
44
 
36
45
-- | The name of the default CSS file.
37
46
 
58
67
        cssFile <- getDataFileName defaultCSSFile
59
68
        copyFile cssFile (dir </> defaultCSSFile)
60
69
 
61
 
      TCM.reportSLn "html" 1 $
62
 
        "\nWarning: HTML is currently generated for ALL files which can be\n\
63
 
        \reached from the given module, including library files.\n"
 
70
      TCM.reportSLn "html" 1 $ unlines
 
71
        [ ""
 
72
        , "Warning: HTML is currently generated for ALL files which can be"
 
73
        , "reached from the given module, including library files."
 
74
        ]
64
75
 
65
76
      -- Pull highlighting info from the state and generate all the
66
77
      -- web pages.
67
78
      mapM_ (\(m, h) -> generatePage dir m h) =<<
68
 
        map (id *** TCM.iHighlighting) . Map.toList <$>
69
 
          TCM.getAllModules
 
79
        map (id *** TCM.iHighlighting . TCM.miInterface) .
 
80
          Map.toList <$> TCM.getVisitedModules
70
81
 
71
82
-- | Converts module names to the corresponding HTML file names.
72
83
 
73
 
modToFile :: [String] -> FilePath
74
 
modToFile m = List.intercalate "." m <.> "html"
 
84
modToFile :: C.TopLevelModuleName -> FilePath
 
85
modToFile m = render (pretty m) <.> "html"
75
86
 
76
87
-- | Generates an HTML file with a highlighted, hyperlinked version of
77
88
-- the given module.
78
89
 
79
90
generatePage
80
 
  :: FilePath         -- ^ Directory in which to create files.
81
 
  -> A.ModuleName     -- ^ Module to be highlighted.
82
 
  -> HighlightingInfo -- ^ Syntax highlighting info for the module.
 
91
  :: FilePath              -- ^ Directory in which to create files.
 
92
  -> C.TopLevelModuleName  -- ^ Module to be highlighted.
 
93
  -> HighlightingInfo      -- ^ Syntax highlighting info for the module.
83
94
  -> TCM ()
84
95
generatePage dir mod highlighting = do
85
 
  contents <- liftIO $ UTF8.readTextFile (source highlighting)
86
 
  css      <- maybe defaultCSSFile id . optCSSFile <$>
87
 
                TCM.commandLineOptions
88
 
  let html = page css mod contents (info highlighting)
89
 
  TCM.reportSLn "html" 1 $ "Generating HTML for " ++ show mod ++
90
 
                           " (" ++ target ++ ")."
91
 
  liftIO $ UTF8.writeFile target (renderHtml html)
92
 
  where target = dir </> modToFile (map show $ A.mnameToList mod)
 
96
  mf <- Map.lookup mod . TCM.stModuleToSource <$> get
 
97
  case mf of
 
98
    Nothing -> __IMPOSSIBLE__
 
99
    Just f  -> do
 
100
      contents <- liftIO $ UTF8.readTextFile $ filePath f
 
101
      css      <- maybe defaultCSSFile id . optCSSFile <$>
 
102
                    TCM.commandLineOptions
 
103
      let html = page css mod contents highlighting
 
104
      TCM.reportSLn "html" 1 $ "Generating HTML for " ++
 
105
                               render (pretty mod) ++
 
106
                               " (" ++ target ++ ")."
 
107
      liftIO $ UTF8.writeFile target (renderHtml html)
 
108
  where target = dir </> modToFile mod
93
109
 
94
110
-- | Constructs the web page, including headers.
95
111
 
96
 
page :: FilePath       -- ^ URL to the CSS file.
97
 
     -> A.ModuleName   -- ^ Module to be highlighted.
98
 
     -> String         -- ^ The contents of the module.
99
 
     -> CompressedFile -- ^ Highlighting information.
 
112
page :: FilePath              -- ^ URL to the CSS file.
 
113
     -> C.TopLevelModuleName  -- ^ Module to be highlighted.
 
114
     -> String                -- ^ The contents of the module.
 
115
     -> CompressedFile        -- ^ Highlighting information.
100
116
     -> Html
101
117
page css modName contents info =
102
 
  header (thetitle << show modName
 
118
  header (thetitle << render (pretty modName)
103
119
            +++
104
120
          meta ! [ httpequiv "Content-Type"
105
121
                 , content "text/html; charset=UTF-8"
163
179
    -- Notes are not included.
164
180
    noteClasses s = []
165
181
 
166
 
    link (m, f, pos) = [href $ modToFile m ++ "#" ++ show pos]
 
182
    link (m, pos) = [href $ modToFile m ++ "#" ++ show pos]