hpaco-0.26.0.0: Main.hs

module Main where

import CommandArgs
import Control.Monad (liftM, when)
import Control.Applicative ( (<|>) )
import Data.List
import Data.Maybe
import Data.ByteString.UTF8 as BS8
import Data.ByteString.Lazy.UTF8 as LBS8
import Data.Aeson as JSON
import Data.Yaml as YAML
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

roundTripYaml :: Monad m => String -> m String
roundTripYaml s =
    maybe (fail "Invalid YAML") (return . LBS8.toString . JSON.encode) .
        (YAML.decode :: BS8.ByteString -> Maybe JSON.Value) .
        BS8.fromString $ s

process :: CommandArgs -> String -> FilePath -> String -> IO String
process cmdargs templateName filename src = do
    let reader = getReader cmdargs filename filename
        write = getWriter cmdargs templateName
    rundata <- roundTripYaml $ caRunData cmdargs
    let 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
                                }