{-#LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} module CommandArgs ( CommandArgs (..) , parseArgs , OutputFormat (..) , InputLanguage (..) , PacoFlavorStyle (..) ) where import System.Console.CmdArgs.Implicit import System.Environment import qualified Text.HPaco.Writers.PHP as PHP import qualified Text.HPaco.Writers.Javascript as Javascript import System.FilePath import Text.HPaco.Writers.Internal.WrapMode deriving instance Show WrapMode deriving instance Data WrapMode deriving instance Typeable WrapMode programVersion = "0.28.0.5" data OutputFormat = OutputPHP | OutputJavascript | OutputJsonLisp | RunInterpreted | ListDependencies | DumpRawAST deriving (Show, Data, Typeable) data InputLanguage = Paco | Capo deriving (Show, Data, Typeable) data PacoFlavorStyle = Default | Jinja | CSS deriving (Show, Data, Typeable) data CommandArgs = CommandArgs { caInputFiles :: [FilePath] , caTemplateName :: Maybe String , caOptimizationLevel :: Int , caOutputFormat :: OutputFormat , caInputLanguage :: Maybe InputLanguage , caToStdout :: Bool , caIncludeExtension :: Maybe String , caPretty :: Bool , caNoPreamble :: Bool , caWrapMode :: WrapMode , caPhpExposeAllFunctions :: Bool , caRunData :: String , caSourcePositions :: Bool , caPacoFlavor :: PacoFlavorStyle } deriving (Show, Data, Typeable) parseArgs = cmdArgs argsParser argsParser = CommandArgs { caTemplateName = def &= name "template-name" &= help "Template name used in output" &= explicit , caOptimizationLevel = def &= name "O" &= help "Optimization level (currently 0 and 1 supported)" &= explicit , caIncludeExtension = def &= name "include-ext" &= help "Extension to append to included templates" &= explicit , caToStdout = def &= name "f" -- &= name "filter" &= help "Write to stdout (filter mode)" &= explicit , caOutputFormat = enum [ OutputPHP &= name "php" &= help "Compile to PHP" &= explicit , OutputJavascript &= name "js" &= help "Compile to JavaScript" &= explicit , OutputJsonLisp &= name "jsl" &= help "Compile to JsonLisp (intermediate language)" &= explicit , RunInterpreted &= name "run" &= help "Run directly (act as an interpreter)" &= explicit , ListDependencies &= name "deps" &= help "List dependencies and exit" &= explicit , DumpRawAST &= name "raw-ast" &= help "Dump raw AST data structures in Haskell format" &= explicit ] , caInputLanguage = enum [ Just Paco &= name "paco" &= help "Input language is Paco" &= explicit , Just Capo &= name "capo" &= help "Input language is Capo" &= explicit ] , caPretty = def &= name "pretty" &= name "js-pretty" &= name "php-pretty" &= help "Output pretty-printed PHP" &= explicit &= groupname "Code format options" , caPhpExposeAllFunctions = def &= name "php-expose-all-functions" &= help "Expose all defined PHP functions from the host to the template" &= explicit &= groupname "PHP writer options" , caNoPreamble = def &= name "no-preamble" &= name "php-no-preamble" &= help "Skip preamble (defines functions used in template)" &= explicit &= groupname "Code format options" , caSourcePositions = def &= name "source-positions" &= help "Insert source position comments into the output" &= explicit &= groupname "Code format options" , caWrapMode = enum [ WrapNone &= name "raw" &= name "php-raw" &= name "js-raw" &= help "Output raw code without any wrapper" &= explicit , WrapFunction &= name "func" &= name "php-func" &= name "js-func" &= help "Wrap code in a function" &= explicit , WrapClass &= name "class" &= name "php-class" &= help "Wrap code in a class (for backends that support it)" &= explicit ] &= groupname "Code format options" , caRunData = def &= name "data" &= help "Initial scope" &= explicit , caPacoFlavor = enum [ Default &= name "default-flavor" &= help "default flavor: {%-- comments --%}, {variables}, {% tags %}" &= explicit , Jinja &= name "jinja" &= name "jinja-flavor" &= help "jinja flavor: {# comments #}, {{variables}}, {% tags %}" &= explicit , CSS &= name "css" &= name "css-flavor" &= help "css flavor: /*-- comments --*/, /** variables **/, /*% tags %*/" &= explicit ] , caInputFiles = def &= args } &= program "hpaco" &= details [ "a compiler for the paco template language" ] &= summary ("hpaco " ++ programVersion ++ " Copyright (c) 2012 by Tobias Dammers. All rights reserved")