{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK prune #-}
module System.Console.Docopt.QQ
    (
    -- * QuasiQuoter usage parsers
      docopt
    , docoptFile
    ) where

import qualified Data.Map as M

import System.Console.Docopt.Types
import System.Console.Docopt.QQ.Instances ()
import System.Console.Docopt.ApplicativeParsec
import System.Console.Docopt.UsageParse

import Language.Haskell.TH
import Language.Haskell.TH.Quote

parseFmt :: FilePath -> String -> Either ParseError OptFormat
parseFmt :: FilePath -> FilePath -> Either ParseError OptFormat
parseFmt = GenParser Char OptInfoMap OptFormat
-> OptInfoMap
-> FilePath
-> FilePath
-> Either ParseError OptFormat
forall tok st a.
GenParser tok st a
-> st -> FilePath -> [tok] -> Either ParseError a
runParser GenParser Char OptInfoMap OptFormat
pDocopt OptInfoMap
forall k a. Map k a
M.empty

docoptExp :: String -> Q Exp
docoptExp :: FilePath -> Q Exp
docoptExp FilePath
rawUsg = do
  let usg :: FilePath
usg = FilePath -> FilePath
trimEmptyLines FilePath
rawUsg
  let mkDocopt :: OptFormat -> Docopt
mkDocopt OptFormat
fmt = Docopt :: OptFormat -> FilePath -> Docopt
Docopt { usage :: FilePath
usage = FilePath
usg, optFormat :: OptFormat
optFormat = OptFormat
fmt }
  FilePath
loc <- Loc -> FilePath
loc_filename (Loc -> FilePath) -> Q Loc -> Q FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Loc
location
  case OptFormat -> Docopt
mkDocopt (OptFormat -> Docopt)
-> Either ParseError OptFormat -> Either ParseError Docopt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> Either ParseError OptFormat
parseFmt FilePath
loc FilePath
usg of
    Left ParseError
err     -> FilePath -> Q Exp
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q Exp) -> FilePath -> Q Exp
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
    Right Docopt
parser -> [| parser |]

-- | A 'QuasiQuoter' which parses a usage string and returns a
-- 'Docopt'.
--
-- Example usage:
--
-- @
-- patterns :: Docopt
-- patterns = [docopt|
-- docopt-sample version 0.1.0
--
-- Usage:
--   docopt-sample cat \<file\>
--   docopt-sample echo [--caps] \<string\>
--
-- Options:
--   -c, --caps    Caps-lock the echoed argument
-- |]
-- @
--
-- For help with the docopt usage format, see
-- <https://github.com/docopt/docopt.hs/blob/master/README.md#help-text-format the readme on github>.
docopt :: QuasiQuoter
docopt :: QuasiQuoter
docopt = QuasiQuoter :: (FilePath -> Q Exp)
-> (FilePath -> Q Pat)
-> (FilePath -> Q Type)
-> (FilePath -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: FilePath -> Q Exp
quoteExp  = FilePath -> Q Exp
docoptExp
                     , quoteDec :: FilePath -> Q [Dec]
quoteDec  = FilePath -> FilePath -> Q [Dec]
forall a. FilePath -> FilePath -> Q a
unsupported FilePath
"Declaration"
                     , quotePat :: FilePath -> Q Pat
quotePat  = FilePath -> FilePath -> Q Pat
forall a. FilePath -> FilePath -> Q a
unsupported FilePath
"Pattern"
                     , quoteType :: FilePath -> Q Type
quoteType = FilePath -> FilePath -> Q Type
forall a. FilePath -> FilePath -> Q a
unsupported FilePath
"Type"
                     }
    where unsupported :: String -> String -> Q a
          unsupported :: FilePath -> FilePath -> Q a
unsupported FilePath
qqType FilePath
_ = do
            FilePath -> Q a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q a) -> FilePath -> Q a
forall a b. (a -> b) -> a -> b
$ (FilePath
qqType FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" context unsupported")

-- | Same as 'docopt', but parses the given file instead of a literal
-- string.
--
-- Example:
--
-- @
-- patterns :: Docopt
-- patterns = [docoptFile|USAGE|]
-- @
--
-- where @USAGE@ is the name of a file which contains the usage
-- string (relative to the directory from which ghc is invoked).
docoptFile :: QuasiQuoter
docoptFile :: QuasiQuoter
docoptFile = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
docopt