{-
    Text.HTML.Chunks : simple templates with static safety
    Copyright (C) 2007  Matthew Sackman

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

-- | Whilst the syntax for modules makes use of HTML-style comments,
--   there is nothing preventing the use of templates for non-HTML
--   purposes.
--
--   Chunks are delimited by @\<!-- BEGIN /name/ --> /some text/ \<!--
--   END -->@ where @/name/@ specifies the name of the chunk, and
--   @/some text/@ is replaced by whatever you wish to appear within
--   the chunk.  Chunks can be nested but this is /only/ for
--   convenience: a nested chunk is /never/ output as part of its
--   parent chunk. The purpose of allowing nesting is so that the
--   template can be constructed so that it itself renders acceptably
--   in a browser.
--
--   Variables can be specified in the content of the chunk by
--   @\#\#/name/\#\#@ where @/name/@ is the variable name. In order to
--   prevent the variables from appearing in the template when
--   rendered in a browser, the variable may be set in a comment as
--   long as it's the only thing in the comment, e.g. @\<!--
--   \#\#/name/\#\# -->@
--
--   Typical use is to use the splice syntax (ghc needs @-fth@ for
--   this) to include the chunk definitions in the currrent module,
--   e.g.
--
-- @
--   $(chunksFromFile \"\/path\/to\/templates\/template_01.html\")
-- @
--
--   This causes, /at compile time/, the template to be parsed and for
--   the chunks to be converted into @data@ declarations which are
--   instances of both 'Show' (for debugging purposes) and 'Chunk'
--   (for formatting purposes). The template is thus incorporated
--   directly within the executable eliminating the dependency on the
--   template at runtime. This also means that if you just change the
--   template then you must recompile with @-fforce-recomp@ inorder to
--   force the recompilation.
--
--   The naming convention used converts the names of chunks to
--   @Chunk_/name/@ and chunk variables to fields in the data type
--   with names of @/chunk-name/_/var-name/@. The function
--   'showChunksData' exists to allow you to inspect these.
module Text.HTML.Chunks
    (chunksFromFile,
     showChunksData,
     showChunksAll,
     Chunk(format)
    )
    where

import qualified Text.HTML.Chunks.Parser as P
import qualified Text.HTML.Chunks.TH as TH
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Data.List

class Chunk a where
    -- | The instances of 'Chunk' that are built by 'chunksFromFile'
    -- incorporate into the implementation of 'format' all the textual
    -- content of the chunk. Supplying a value of the automatically
    -- generated data type @Chunk_/*/@ will use the fields in the
    -- value to fill in all variables within the chunk.
    format :: a -> String

-- | Parse the supplied file and generate the Haskell AST representing
-- data-type declarations of the chunks with instances of 'Chunk'
-- incorporating the body of the chunks. Expected use is through
-- splicing (ghc needs @-fth@ option for this):
--
-- @
--   $(chunksFromFile \"\/path\/to\/templates\/template_01.html\")
-- @
chunksFromFile :: FilePath -> Q [Dec]
chunksFromFile fileName = do { file <- runIO (readFile fileName)
                             ; let chunks = P.findChunks file
                             ; dataDecls <- TH.declsD chunks
                             ; funcDecls <- TH.declsF chunks
                             ; return (dataDecls ++ funcDecls)
                             }

-- | Parse the supplied file for chunks and return a string
-- representing the code generated for the data-type declarations only
-- of the chunks. This is useful for debugging purposes, particularly
-- from within @ghci@. E.g.
--
-- @
--   \> showChunksData \"\/path\/to\/templates\/template_01.html\" \>\>= putStrLn
-- @
showChunksData :: FilePath -> IO String
showChunksData fileName = do { file <- readFile fileName
                             ; let chunks = P.findChunks file
                             ; dataDecls <- runQ (TH.declsD chunks)
                             ; return (pprint dataDecls)
                             }

-- | Parse the supplied file for chunks and return a string
-- representing all the code generated for the chunks. This will
-- return both the text of the data-declarations and the instance
-- 'Chunk' declarations. The instance declarations will often be very
-- large as they incorporated the text of the chunk taken from the
-- template.
showChunksAll :: FilePath -> IO String
showChunksAll fileName = do { file <- readFile fileName
                            ; let chunks = P.findChunks file
                            ; dataDecls <- runQ (TH.declsD chunks)
                            ; funcDecls <- runQ (TH.declsF chunks)
                            ; return $ (pprint dataDecls) ++ "\n" ++ (pprint funcDecls)
                            }