packages feed

hpaco-0.18.0.0: Main.hs

module Main where

import CommandArgs
import Control.Monad (liftM, when)
import Control.Applicative ( (<|>) )
import Data.List
import Data.Maybe
import Prelude hiding (getContents)
import System.FilePath
import System.IO (withFile, IOMode (ReadMode, WriteMode), hPutStr, hPutStrLn, stdout)
import System.IO.Strict
import Text.HPaco.Reader (Reader)
import Text.HPaco.Readers.Paco
import Text.HPaco.Optimizer
import Text.HPaco.Writer as W
import qualified Text.HPaco.Writers.PHP as PHP
import qualified Text.HPaco.Writers.Run as Run
import qualified Text.HPaco.Writers.Javascript as JS
import qualified Text.HPaco.Writers.Dependencies as Deps
import qualified Text.HPaco.Writers.JsonLisp as JsonLisp
import Text.HPaco.Writer (Writer)

main = do
    argStruct <- parseArgs
    let optimizationLevel = caOptimizationLevel argStruct
    when (optimizationLevel > 1) $
        putStrLn $ "Warning: Optimization level " ++ show optimizationLevel ++ " requested, using 1 instead"
    let filenames = caInputFiles argStruct

    if null filenames
        then processStdin argStruct
        else mapM_ (processFile argStruct) filenames

processStdin :: CommandArgs -> IO ()
processStdin cmdargs =
    getContents >>= process cmdargs "" "<STDIN>" >>= putStr

outputFilename :: CommandArgs -> FilePath -> FilePath
outputFilename cmdargs srcFilename = replaceExtension srcFilename (outputFormatExtension . caOutputFormat $ cmdargs)

processFile :: CommandArgs -> FilePath -> IO ()
processFile cmdargs srcFilename = do
    src <- withFile srcFilename ReadMode hGetContents
    let dstFilename = outputFilename cmdargs srcFilename
    dst <- process cmdargs (takeBaseName srcFilename) srcFilename src
    if caToStdout cmdargs
        then putStr dst
        else withFile dstFilename WriteMode $ flip hPutStr dst

process :: CommandArgs -> String -> FilePath -> String -> IO String
process cmdargs templateName filename src = do
    let reader = getReader cmdargs filename filename
        write = getWriter cmdargs templateName
        rundata = caRunData cmdargs
        pre = "{%with " ++ rundata ++ " %}\n"
        post = "{%endwith%}\n"
        src' = if null rundata
                    then src
                    else pre ++ src ++ post
        optimizationLevel = caOptimizationLevel cmdargs 
        opt = case optimizationLevel of
                0 -> id
                otherwise -> optimize
    ast <- reader src'
    case caOutputFormat cmdargs of
        RunInterpreted -> runInterpreted (opt ast) cmdargs templateName >> return "\n"
        ListDependencies -> return . getWriter cmdargs filename $ ast
        otherwise -> return . write . opt $ ast
    where runInterpreted ast cmdargs templateName =
            let opts = Run.defaultOptions
                        { Run.roTemplateName = templateName `fromMaybe` caTemplateName cmdargs
                        }
            in Run.run opts ast

outputFormatExtension :: OutputFormat -> String
outputFormatExtension OutputPHP = "php"
outputFormatExtension OutputJavascript = "js"
outputFormatExtension OutputJsonLisp = "jslisp"
outputFormatExtension RunInterpreted = ""
outputFormatExtension ListDependencies = "dep"

getReader :: CommandArgs -> FilePath -> Reader
getReader cmdargs filePath =
    case getEffectiveInputLanguage cmdargs filePath of
        Paco -> readPaco
        Capo -> readCapo

getEffectiveInputLanguage :: CommandArgs -> FilePath -> InputLanguage
getEffectiveInputLanguage cmdargs filePath =
    let Just effectiveInputLanguage =
            caInputLanguage cmdargs
            <|> inputLanguageFromFilename filePath
            <|> Just Paco
    in effectiveInputLanguage
    
inputLanguageFromFilename :: FilePath -> Maybe InputLanguage
inputLanguageFromFilename fn =
    case takeExtension fn of
        ".paco" -> Just Paco
        ".capo" -> Just Capo
        otherwise -> Nothing

getWriter :: CommandArgs -> String -> Writer
getWriter cmdargs templateName =
    go (caOutputFormat cmdargs) cmdargs templateName
    where
        go :: OutputFormat -> CommandArgs -> String -> Writer
        go DumpRawAST _ _ = show
        go ListDependencies cmdargs templateName =
            Deps.writeDependencies templateName
        go OutputJsonLisp cmdargs templateName =
            JsonLisp.writeJsonLisp
        go OutputJavascript cmdargs templateName =
            JS.writeJavascript $ JS.defJsWriterOptions
                                    { woPrettyPrint = caPretty cmdargs
                                    , woTemplateName = templateName `fromMaybe` caTemplateName cmdargs
                                    , woIncludePreamble = not . caNoPreamble $ cmdargs
                                    , woWrapMode = caWrapMode cmdargs
                                    , woSourcePositionComments = caSourcePositions cmdargs
                                    }
        go OutputPHP cmdargs templateName =
            PHP.writePHP $ PHP.defPHPWriterOptions
                                { woPrettyPrint = caPretty cmdargs
                                , woTemplateName = templateName `fromMaybe` caTemplateName cmdargs
                                , woIncludePreamble = not . caNoPreamble $ cmdargs
                                , woWrapMode = caWrapMode cmdargs
                                , woExposeAllFunctions = caPhpExposeAllFunctions cmdargs
                                , woSourcePositionComments = caSourcePositions cmdargs
                                }