{-#LANGUAGE OverloadedStrings#-}

module Yesod.Raml.Routes.Internal where

import Control.Applicative
import Control.Monad
import qualified Data.Yaml as Y
import qualified Data.Yaml.Include as YI
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Data.Char as C
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import Yesod.Raml.Type
import Yesod.Raml.Parser()

import Text.Regex.Posix hiding (empty)
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote

import Yesod.Routes.TH.Types
import Network.URI hiding (path)

routesFromRaml ::  Raml -> Either String [RouteEx]
routesFromRaml raml = do
  let buri =  T.replace "{version}" (version raml) (baseUri raml)
  uripaths <- case parsePath buri of
    (Just uri) -> return $ fmap ("/" <> ) $ T.split (== '/') $ if T.isPrefixOf "/" uri then T.tail uri else uri
    Nothing -> Left $ "can not parse: " ++  (T.unpack buri)
  v <- forM (M.toList (paths raml)) $ \(k,v) -> do
    routesFromRamlResource v $ uripaths ++ splitPath k
  return $ concat v
  where
    parsePath uri = fmap T.pack $ fmap uriPath $ parseURI (T.unpack uri)

splitPath :: T.Text -> [T.Text]
splitPath path = 
  case T.split (== '/') path of
    (_:xs) -> map (T.append "/") xs
    _  -> [path]


methodExFromRamlMethod ::  (Method,RamlMethod) ->  MethodEx
methodExFromRamlMethod (method,val) =
  let example = do
        response <-  M.lookup "200" (m_responses val)
        (contentType,body) <- listToMaybe (M.toList (res_body response))
        ex <- res_example body
        return (contentType,ex)
  in MethodEx (T.unpack (T.toUpper (method))) example

routesFromRamlResource :: RamlResource -> [Path] -> Either String [RouteEx]
routesFromRamlResource raml paths' = do
  rrlist <- forM (M.toList (r_paths raml)) $ \(k,v) -> do
    routesFromRamlResource v (paths' ++ splitPath k)
  let rlist = concat rrlist
  case toHandler Nothing raml of
    Right handle -> do
      let methods =  flip map  (M.toList (r_methods raml)) methodExFromRamlMethod
          route = RouteEx {
              re_pieces = toPieces paths'
            , re_handler = T.unpack handle
            , re_methods = methods
            }
      return $ route : rlist
    Left err -> do
      case rrlist of
        [] -> Left err
        _ -> return rlist
      
toHandler :: Maybe HandlerHint -> RamlResource -> Either String Handler
toHandler mhint ramlMethod =
  (fromHandlerTag ramlMethod) <|>
  (fromDescription (fromMaybe "handler: *(.*)" mhint) ramlMethod)
  where
    fromHandlerTag :: RamlResource -> Either String Handler
    fromHandlerTag ramlMethod' = do
      handler <- case r_handler ramlMethod' of
        Nothing -> Left "handler of method is empty"
        (Just desc') -> return desc'
      return handler
    fromRegex :: T.Text -> T.Text -> Maybe T.Text
    fromRegex pattern str =
      let v = (T.unpack str) =~ (T.unpack pattern) :: (String,String,String,[String])
      in case v of
        (_,_,_,[]) -> Nothing
        (_,_,_,h:_) -> Just $ T.pack h
    fromDescription :: HandlerHint -> RamlResource -> Either String Handler
    fromDescription hint ramlMethod' = do
      desc <- case r_description ramlMethod' of
        Nothing -> Left "Description of method is empty"
        (Just desc') -> return desc'
      case (foldr (<|>) empty $ map (fromRegex hint) $ T.lines $ desc) of
        Nothing -> Left "Can not find Handler"
        Just handler -> return handler

toYesodResource :: RouteEx ->  Resource String
toYesodResource route =
  Resource {
    resourceName = re_handler route
  , resourcePieces = re_pieces route
  , resourceDispatch =
      Methods {
        methodsMulti = Nothing
      , methodsMethods = map me_method (re_methods route)
      }
  , resourceAttrs = []
  , resourceCheck = True
  }

toRoutesFromString :: String -> [ResourceTree String]
toRoutesFromString ramlStr =
  let eRaml = Y.decodeEither (B.pack ramlStr) :: Either String Raml
      raml = case eRaml of
        Right v -> v
        Left e -> error $ "Invalid raml :" ++ e
      routes = case (routesFromRaml raml) of
        Right v -> v
        Left e -> error $ "Invalid resource : " ++ e
  in map ResourceLeaf $ map toYesodResource routes

toRoutesFromFile :: String -> IO [ResourceTree String]
toRoutesFromFile file = do
  eRaml <- YI.decodeFileEither file
  let raml = case eRaml of
        Right v -> v
        Left e -> error $ "Invalid raml :" ++ show e
      routes = case (routesFromRaml raml) of
        Right v -> v
        Left e -> error $ "Invalid resource : " ++ e
  return $ map ResourceLeaf $ map toYesodResource routes


capitalize :: String -> String
capitalize [] = []
capitalize (h:str) = C.toUpper h:str

toPiece :: T.Text -> Piece String
toPiece str | T.isPrefixOf "/{" str && T.isSuffixOf "}" str= Dynamic $ capitalize $ T.unpack $ T.takeWhile (/= '}') $ T.tail $ T.dropWhile (/= '{') str
            | T.isPrefixOf "/" str = Static $ T.unpack $ T.tail str
            | otherwise = error "Prefix is not '/'."

fromPiece ::  Piece String ->  T.Text
fromPiece (Static str) = "/" <> T.pack str
fromPiece (Dynamic str) = "/#" <> T.pack str

toPieces :: [Path] -> [Piece String]
toPieces paths' = map toPiece paths'

fromPieces ::  [Piece String] ->  [Path]
fromPieces paths' = map fromPiece paths'

toYesodRoutes ::  [RouteEx] ->  T.Text
toYesodRoutes routes = foldr (\a b ->  toRoute a <> "\n" <> b ) "" routes
  where
    toRoute ::  RouteEx ->  T.Text
    toRoute r = foldr (<>) "" (fromPieces (re_pieces r)) <> " " <>
                          T.pack (re_handler r) <> " " <>
                          T.intercalate " " (map (T.pack.me_method) (re_methods r))


parseRamlRoutes :: QuasiQuoter
parseRamlRoutes = QuasiQuoter
    { quoteExp = lift . toRoutesFromString
    , quotePat = undefined
    , quoteType = undefined
    , quoteDec = undefined            
    }

parseRamlRoutesFile :: FilePath -> Q Exp
parseRamlRoutesFile file = do
  qAddDependentFile file
  s <- qRunIO $ toRoutesFromFile file
  lift s