{-# LANGUAGE CPP, TemplateHaskell, TupleSections, LambdaCase #-}

module NgxExport.Log.Gen where

import           NgxExport.Log.Base

import           Language.Haskell.TH
import           Control.Arrow
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import           Data.Char

#if MIN_VERSION_template_haskell(2,18,0)
#define FUND funD_doc
#else
#define FUND funD
#endif

do
    TyConI (DataD _ _ _ _ lCs _) <- reify ''LogLevel
    let lCons = map (\case
                         NormalC con [] -> con
                         _ -> undefined
                    ) lCs
        flr = mkName "logR"
        lCons' = map ((, 'logG) . (id &&& toFuncName . nameBase)) lCons ++
            map ((, flr) . (id &&& toFuncName . (++ "R") . nameBase)) lCons
        toFuncName (h : t) = toLower h : t
        toFuncName _ = undefined
        flf = mkName "logFuncs"
    sequence $
        [sigD flf [t|[String]|]
        ,funD flf [clause []
                      (normalB $
                          listE $ map (litE . stringL . snd . fst) lCons'
                      ) []
                  ]
        ]
        ++
        concatMap
        (\((con, fn), f) ->
             let fl = mkName fn
             in [sigD fl [t|ByteString -> IO L.ByteString|]
                ,FUND fl [clause [varP $ mkName "msg"]
                             (normalB
                                 [|$(varE f) $(conE con) msg >> return L.empty|]
                             ) []
                         ]
#if MIN_VERSION_template_haskell(2,18,0)
                         (Just $ "Logs a message with severity '" ++
                             nameBase con ++ "' to the " ++
                                 (if f == flr
                                      then "request's "
                                      else "global "
                                 ) ++ "Nginx log.\n\n" ++
                                 "This is the core function of the /" ++ fn ++
                                 "/ handler."
                         ) [Just "Log message"]
#endif
                ]
        ) lCons'