module YesodDsl.Generator.HsClient (moduleToHsClient) where
import YesodDsl.AST
import Data.List
import Data.Maybe
import Data.Char (toLower)
import Data.String.Utils (rstrip)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Shakespeare.Text hiding (toText)
import Data.Generics.Uniplate.Data
import YesodDsl.Generator.Common
import YesodDsl.Generator.Input
import YesodDsl.Generator.Models
import YesodDsl.Generator.Client
import System.FilePath (joinPath)
mkField :: FieldName -> (Bool,FieldContent) -> Field
mkField n (o,c) = Field (Loc "" 0 0) o n c [] Nothing
moduleToHsClient :: Module -> [(FilePath, String)]
moduleToHsClient m = [
(baseName ++".hs", T.unpack $(codegenFile "codegen/hs-client.cg")),
(joinPath [baseName, "Result.hs"], T.unpack $(codegenFile "codegen/hs-client-result.cg")),
(joinPath [baseName, "Types.hs"], T.unpack $(codegenFile "codegen/hs-client-types.cg")),
(joinPath [baseName, "Json.hs"], T.unpack $(codegenFile "codegen/hs-client-json.cg")),
(joinPath [baseName, "Enums.hs"], T.unpack $(codegenFile "codegen/hs-client-enums.cg"))
] ++ [ (handlerFileName r h, handler r h)
| r <- modRoutes m, h <- routeHandlers r ]
++ [ (enumFileName e, enum e) | e <- modEnums m ]
where
importEnum e = T.unpack $(codegenFile "codegen/hs-client-import-enum.cg")
exportEnum e = T.unpack $(codegenFile "codegen/hs-client-export-enum.cg")
entityIdType e = T.unpack $(codegenFile "codegen/hs-client-idtypes-entity.cg")
baseName = moduleName m ++ "Client"
handlerFileName r h = joinPath [ baseName, (upperFirst . (map toLower) . show . handlerType) h ++ concatMap pathName (routePath r) ++ ".hs"]
enumFileName e = joinPath [ baseName, enumName e ++ ".hs" ]
enum e = T.unpack $(codegenFile "codegen/hs-client-enum.cg")
handler r h
| handlerType h == GetHandler = T.unpack $(codegenFile "codegen/hs-client-handler-get.cg")
| null $ handlerInputFields h =T.unpack $(codegenFile "codegen/hs-client-handler-update-empty-body.cg")
| otherwise = T.unpack $(codegenFile "codegen/hs-client-handler-update.cg")
where
ifBodyAllowed content
| handlerType h `elem` [PutHandler, PostHandler] = content :: String
| otherwise = ""
fieldLabelModifier (src, dst) = T.unpack $(codegenFile "codegen/hs-client-field-label-modifier.cg")
fieldLabelModifiers = [ (safeHsName $ fieldJsonName f, fieldJsonName f) | f <- handlerOutputFields m h, safeHsName (fieldJsonName f) /= fieldJsonName f ]
maybeFieldLabelModifier
| null fieldLabelModifiers = ""
| otherwise = T.unpack $(codegenFile "codegen/hs-client-field-label-modifiers.cg")
methodName = map toLower $ show $ handlerType h
defineResultType
| null $ handlerOutputFields m h = "type Result = A.Value" :: String
| otherwise = T.unpack $(codegenFile "codegen/hs-client-handler-update-result-type.cg")
field f = rstrip $ T.unpack $(codegenFile "codegen/hs-client-field.cg")
handlerTypeName = upperFirst $ map toLower (show $ handlerType h)
handlerEntityName = handlerTypeName ++ concatMap pathName (routePath r)
pathName pp = case pp of
PathText t -> upperFirst t
PathId _ en -> "_"
routePathParams r = mapMaybe (\(n,pp) -> case pp of
PathText _ -> Nothing
PathId _ en -> Just ("(Key p" ++ show (n::Int) ++ ")",en ++ "Id")) $ zip [1..] (routePath r)
routePathUrl r = concatMap (\(n,pp) -> case pp of
PathText t -> " ++ \"/" ++ t ++ "\""
PathId _ _ -> " ++ \"/\" ++ show p" ++ show (n::Int)) $ zip [1..] (routePath r)
inputField (fn,Just f) = rstrip $ T.unpack $(codegenFile "codegen/hs-client-inputfield.cg")
inputField (fn,Nothing) = rstrip $ T.unpack $(codegenFile "codegen/hs-client-inputfield-unknown.cg")
entity e = T.unpack $(codegenFile "codegen/hs-client-entity.cg")