{-# LANGUAGE
    UnicodeSyntax
  #-}
module Main (main) where
import Control.Applicative
import Control.Monad
import Data.Ascii (Ascii)
import Data.Attempt
import Data.Char
import Data.Convertible.Base
import Data.Convertible.Utils
import Data.Maybe
import Language.Haskell.TH.PprLib
import Language.Haskell.TH.Syntax
import Network.HTTP.Lucu.ETag
import Network.HTTP.Lucu.Implant
import Network.HTTP.Lucu.Implant.PrettyPrint
import Network.HTTP.Lucu.MIMEType
import Prelude.Unicode
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO

data CmdOpt
    = OptOutput FilePath
    | OptModName String
    | OptSymName String
    | OptMIMEType String
    | OptETag String
    | OptHelp
    deriving (Eq, Show)

options ∷ [OptDescr CmdOpt]
options = [ Option "o" ["output"]
                       (ReqArg OptOutput "FILE")
                       "Output to the FILE."

          , Option "m" ["module"]
                       (ReqArg OptModName "MODULE")
                       "Specify the resulting module name. (required)"

          , Option "s" ["symbol"]
                       (ReqArg OptSymName "SYMBOL")
                       "Specify the resulting symbol name."

          , Option "t" ["mime-type"]
                       (ReqArg OptMIMEType "TYPE")
                       "Specify the MIME Type of the file."

          , Option "e" ["etag"]
                       (ReqArg OptETag "TAG")
                       "Specify the ETag of the file."

          , Option "h" ["help"]
                       (NoArg OptHelp)
                       "Print this message."
          ]

printUsage ∷ IO ()
printUsage = do mapM_ putStrLn msg
                putStr $ usageInfo "Options:" options
                putStrLn ""
    where
      msg = [ ""
            , "Description:"
            , concat [ "  lucu-implant-file is an utility that generates "
                     , "Haskell code containing an arbitrary file to "
                     , "compile it directly into programs and serve it "
                     , "statically with the Lucu HTTP server."
                     ]
            , ""
            , "Usage:"
            , "  lucu-implant-file [OPTIONS...] FILE"
            , ""
            ]

main ∷ IO ()
main = do (opts, sources, errors) ← getOpt Permute options <$> getArgs

          unless (null errors)
              $ do mapM_ putStr errors
                   exitWith $ ExitFailure 1

          when (any (≡ OptHelp) opts)
              $ do printUsage
                   exitWith ExitSuccess

          when (null sources)
               $ do printUsage
                    exitWith $ ExitFailure 1

          when (length sources ≥ 2)
               $ fail "too many input files."

          generateHaskellSource opts (head sources)

getMIMEType ∷ [CmdOpt] → Maybe MIMEType
getMIMEType opts
    = case mimeTypeOpts of
        []  → Nothing
        OptMIMEType ty:[]
            → case convertAttemptVia ((⊥) ∷ Ascii) ty of
                 Success a → Just a
                 Failure e → error (show e)
        _   → error "too many --mime-type options."
    where
      mimeTypeOpts ∷ [CmdOpt]
      mimeTypeOpts
          = filter (\ x → case x of
                             OptMIMEType _ → True
                             _             → False) opts

getETag ∷ [CmdOpt] → Maybe ETag
getETag opts
    = case eTagOpts of
        []             → Nothing
        OptETag str:[] → Just $ strToETag str
        _              → error "too many --etag options."
    where
      eTagOpts ∷ [CmdOpt]
      eTagOpts = filter (\ x → case x of
                                  OptETag _ → True
                                  _         → False) opts

      strToETag ∷ String → ETag
      strToETag str
          = case ca str of
              Success a → strongETag a
              Failure e → error (show e)

openOutput ∷ [CmdOpt] → IO Handle
openOutput opts
    = case outputOpts of
        []                 → return stdout
        OptOutput fpath:[] → do h ← openFile fpath WriteMode
                                hSetEncoding h utf8
                                return h
        _                  → fail "two many --output options."
    where
      outputOpts ∷ [CmdOpt]
      outputOpts = filter (\ x → case x of
                                    OptOutput _ → True
                                    _           → False) opts

getModuleName ∷ [CmdOpt] → ModName
getModuleName opts
    = case modNameOpts of
        []                 → error "a module name must be given."
        OptModName name:[] → mkModName name
        _                  → error "too many --module options."
    where
      modNameOpts ∷ [CmdOpt]
      modNameOpts = filter (\ x → case x of
                                     OptModName _ → True
                                     _            → False) opts

getSymbolName ∷ [CmdOpt] → Maybe Name
getSymbolName opts
    = case symNameOpts of
        []                 → Nothing
        OptSymName name:[] → Just $ mkName name
        _                  → fail "too many --symbol options."
    where
      symNameOpts ∷ [CmdOpt]
      symNameOpts = filter (\ x → case x of
                                     OptSymName _ → True
                                     _            → False) opts

defaultSymName ∷ ModName → Name
defaultSymName = headToLower ∘ getLastComp
    where
      headToLower ∷ String → Name
      headToLower []     = error "module name must not be empty"
      headToLower (x:xs) = mkName (toLower x:xs)

      getLastComp ∷ ModName → String
      getLastComp = reverse ∘ fst ∘ break (≡ '.') ∘ reverse ∘ modString

generateHaskellSource ∷ [CmdOpt] → FilePath → IO ()
generateHaskellSource opts srcFile
    = do i   ← openInput srcFile (getMIMEType opts) (getETag opts)
         o   ← openOutput opts
         doc ← pprInput i modName symName
         hPutStrLn o ∘ show $ to_HPJ_Doc doc
         hClose o
    where
      modName ∷ ModName
      modName = getModuleName opts

      symName ∷ Name
      symName = fromMaybe (defaultSymName modName)
                $ getSymbolName opts