packages feed

axel-0.0.7: src/Axel/Parse/Args.hs

module Axel.Parse.Args where
import Axel.Parse.AST as AST
import Data.Semigroup ((<>))
import Options.Applicative
       (Parser, argument, command, info, metavar, progDesc, str,
        subparser)

mdo' :: ((->) ([] AST.Expression) AST.Expression)
mdo' ((:) var ((:) (AST.Symbol "<-") ((:) val rest)))
  = (AST.SExpression
       (concat
          [[(AST.Symbol ">>=")], [val],
           [(AST.SExpression
               (concat
                  [[(AST.Symbol "\\")], [(AST.SExpression (concat [[var]]))],
                   [(mdo' rest)]]))]]))
  where
mdo' ((:) val rest)
  = (case rest of
         [] -> val
         _ -> (AST.SExpression
                 (concat [[(AST.Symbol ">>")], [val], [(mdo' rest)]])))
  where

data Command = File FilePath
             | Project
             | Version

commandParser :: (Parser Command)
commandParser
  = (subparser
       ((<>) projectCommand ((<>) fileCommand versionCommand)))
  where fileCommand
          = (command "file"
               (info ((<$>) File (argument str (metavar "FILE")))
                  (progDesc "Build and run a single file")))
          where
        projectCommand
          = (command "project"
               (info (pure Project) (progDesc "Build and run the project")))
          where
        versionCommand
          = (command "version"
               (info (pure Version)
                  (progDesc "Display the version of the Axel compiler")))
          where
quasiquote_AXEL_AUTOGENERATED_MACRO_DEFINITION
  [(AST.SExpression xs)]
  = (let quasiquoteElem
           = (\ x ->
                (case x of
                     (AST.SExpression [(AST.Symbol "unquote"), x]) -> (AST.SExpression
                                                                         [(AST.Symbol "list"), x])
                     (AST.SExpression
                        [(AST.Symbol "unquoteSplicing"), x]) -> (AST.SExpression
                                                                   [(AST.Symbol
                                                                       "AST.toExpressionList"),
                                                                    x])
                     atom -> (AST.SExpression
                                [(AST.Symbol "list"),
                                 (AST.SExpression [(AST.Symbol "quasiquote"), atom])])))
       in
       (pure
          [(AST.SExpression
              [(AST.Symbol "AST.SExpression"),
               (AST.SExpression
                  [(AST.Symbol "concat"),
                   (AST.SExpression
                      ((:) (AST.Symbol "list") (map quasiquoteElem xs)))])])]))
  where
quasiquote_AXEL_AUTOGENERATED_MACRO_DEFINITION [atom]
  = (pure [(AST.SExpression [(AST.Symbol "quote"), atom])])
  where
applyInfix_AXEL_AUTOGENERATED_MACRO_DEFINITION [x, op, y]
  = (pure [(AST.SExpression (concat [[op], [x], [y]]))])
  where
fnCase_AXEL_AUTOGENERATED_MACRO_DEFINITION cases
  = ((<$>)
       (\ varId ->
          [(AST.SExpression
              (concat
                 [[(AST.Symbol "\\")], [(AST.SExpression (concat [[varId]]))],
                  [(AST.SExpression
                      (concat
                         [[(AST.Symbol "case")], [varId],
                          (AST.toExpressionList cases)]))]]))])
       AST.gensym)
  where
def_AXEL_AUTOGENERATED_MACRO_DEFINITION
  ((:) name ((:) typeSig cases))
  = (pure
       ((:)
          (AST.SExpression (concat [[(AST.Symbol "::")], [name], [typeSig]]))
          (map
             (\ x ->
                (AST.SExpression
                   (concat [[(AST.Symbol "=")], [name], (AST.toExpressionList x)])))
             cases)))
  where
mdo_AXEL_AUTOGENERATED_MACRO_DEFINITION input
  = (pure [(mdo' input)])
  where
if_AXEL_AUTOGENERATED_MACRO_DEFINITION [cond, true, false]
  = (pure
       [(AST.SExpression
           (concat
              [[(AST.Symbol "case")], [cond],
               [(AST.SExpression (concat [[(AST.Symbol "True")], [true]]))],
               [(AST.SExpression (concat [[(AST.Symbol "False")], [false]]))]]))])
  where