module Spicey.RouteGeneration where

import AbstractCurry.Types
import AbstractCurry.Build
import Database.ERD
import Database.ERDGoodies

import Spicey.ControllerGeneration
import Spicey.GenerationHelper

generateRoutesForERD :: ERD -> CurryProg
generateRoutesForERD (ERD _ entities _) =
 let spiceySysCtrl = "SpiceySystemController" in
 CurryProg
  mappingModuleName
  (["Spicey", "Routes", spiceySysCtrl, dataModuleName] ++
   (map (\e -> controllerModuleName (entityName e)) entities)) -- imports
  [] -- typedecls
  [
    cmtfunc 
      ("Maps the controllers associated to URLs in module RoutesData\n"++
       "into the actual controller operations.")
      (mappingModuleName, "getController")
      1 
      Public 
      (baseType (mappingModuleName, "ControllerReference") ~> controllerType)
      [simpleRule [CPVar (1, "fktref")]
         (CCase CRigid (CVar (1, "fktref")) 
              ( [cBranch (CPComb (dataModuleName, "ProcessListController") [])
                         (constF (spiceySysCtrl, "processListController")),
                 cBranch (CPComb (dataModuleName, "LoginController") [])
                         (constF (spiceySysCtrl, "loginController"))] ++
                map branchesForEntity entities ++
                [cBranch (CPVar (2,"_"))
                  (applyF ("Spicey", "displayError")
                          [string2ac "getController: no mapping found"])]
              )
          )]
  ] -- functions
  [] -- opdecls
  
-- startpoint controller prefixes
controllerPrefixes = ["List","New"]

branchesForEntity :: Entity -> (CPattern, CRhs)
branchesForEntity (Entity entityName _) =
  let controllerReference = entityName++"Controller"
   in cBranch (CPComb ("RoutesData", controllerReference) [])
              (constF (controllerReference, "main"++controllerReference))
  
generateStartpointDataForERD :: ERD -> CurryProg
generateStartpointDataForERD (ERD _ entities _) = CurryProg
  dataModuleName
  ["Authentication"] -- imports
  [
    CType (dataModuleName, "ControllerReference") Public []
          ([CCons (dataModuleName, "ProcessListController") Public [],
            CCons (dataModuleName, "LoginController") Public []] ++
           map controllerReferencesForEntity entities),
    urlMatchType,
    routeType
  ] -- typedecls
  [cmtfunc 
     ("This constant specifies the association of URLs to controllers.\n"++
      "Controllers are identified here by constants of type\n"++
      "ControllerReference. The actual mapping of these constants\n"++
      "into the controller operations is specified in the module\n"++
      "ControllerMapping.")
     (dataModuleName, "getRoutes")
     0
     Public 
     (ioType routeMappingType)
     [simpleRule []
        (CDoExpr
          [CSPat (CPVar (1,"login"))
                 (constF ("Authentication","getSessionLogin")),
           CSExpr $ applyF (pre "return")
             [list2ac (
               [tupleExpr
                  [string2ac "Processes",
                   applyF (dataModuleName, "Exact")
                          [string2ac "spiceyProcesses"],
                   constF (dataModuleName, "ProcessListController")]
               ] ++
               concatMap startpointsForEntity entities ++
               [tupleExpr
                  [applyF (pre "maybe")
                          [string2ac "Login",
                           applyF (pre "const") [string2ac "Logout"],
                           CVar (1,"login")],
                   applyF (dataModuleName, "Exact") [string2ac "login"],
                   constF (dataModuleName, "LoginController")],
                tupleExpr
                  [string2ac "default",
                   constF (dataModuleName, "Always"),
                   constF (dataModuleName,
                           firstEntityName entities ++ "Controller")]
               ]
             )
            ]
         ]
        )]
  ] -- functions
  [] -- opdecls
 where
  firstEntityName :: [Entity] -> String
  firstEntityName ((Entity entityName _):_) = entityName

  route :: String -> String -> String -> String -> CExpr
  route desc url uparam controllerDef =
    tupleExpr [string2ac desc,
               applyF (dataModuleName, "Prefix")
                      [string2ac url, string2ac uparam],
               constF (dataModuleName, controllerDef)]

  startpointsForEntity :: Entity -> [CExpr]
  startpointsForEntity (Entity entityName _) =
    map (\pre -> route (pre ++ " " ++ entityName)
                       entityName
                       (lowerFirst pre)
                       (entityName ++ "Controller"))
        controllerPrefixes
      
  urlMatchType :: CTypeDecl
  urlMatchType =
    CType (dataModuleName, "UrlMatch") Public [] [
      CCons (dataModuleName, "Exact")   Public [stringType],
      CCons (dataModuleName, "Prefix")  Public [stringType,stringType],
      CCons (dataModuleName, "Matcher") Public [stringType ~> boolType],
      CCons (dataModuleName, "Always")  Public []
    ]
    
  routeMappingType :: CTypeExpr
  routeMappingType = listType (baseType (dataModuleName,"Route"))
  
  routeType :: CTypeDecl
  routeType =
    CTypeSyn (dataModuleName, "Route") Public []
      (tupleType [stringType,
                  baseType (dataModuleName, "UrlMatch"),
                  baseType (dataModuleName, "ControllerReference")])
    
  controllerReferencesForEntity :: Entity -> CConsDecl
  controllerReferencesForEntity (Entity entityName _) =
    CCons (dataModuleName, entityName++"Controller") Public []