{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
# LANGUAGE FlexibleInstances      #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE OverloadedStrings      #
{-# LANGUAGE TypeOperators         #-}

module Servant.Elm
       ( elmForAPI
       , GenerateList(..)
       , NoTypes
       , HasForeign(..)
       , HasForeignType(..)
  ) where

import           Control.Lens    ((^.))
import           Data.Monoid
import           Data.Proxy
import           Data.Text       (Text)
import qualified Data.Text       as T
import           Servant.Foreign


elmForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
         => Proxy api
         -> Text
elmForAPI p = generateElm (listFromAPI (Proxy :: Proxy NoTypes) p)


-- TODO: allow user to pass output module name
generateElm :: [Req] -> Text
generateElm reqs =
  T.unlines
    [ "-- Generated by servant-elm"
    , "module API where"
    , ""
    , "import Http"
    , "import Task"
    , "import Json.Decode as Decode"
    , ""
    , "type alias Config = {"
    , "    baseURI : String"
    , "  , settings : Http.Settings"
    , "  }"
    , ""
    , "type alias " <> apiType <> " = {"
    , commaSepLines (map curriedFunctionField reqsAndTypeVars)
    , "  }"
    , ""
    , "getAPI : Config -> " <> apiType
    , "getAPI config = {"
    , commaSepLines [elmReqFunctionName req <> " = " <> elmReqFunctionName req <> " config"  | req <- reqs]
    , "  }"
    , ""
    , ""
    , T.intercalate "\n\n" (map elmFunctionDef reqsAndTypeVars)
    ]
  where
    commaSepLines xs = "    " <>  T.intercalate "\n  , " xs
    apiType = "API " <> T.intercalate " " returnTypeVars
    returnTypeVars = typeVarsFor 'a' reqs
    reqsAndTypeVars = zip reqs returnTypeVars


typeVarsFor :: Char -> [a] -> [ElmTypeVar]
typeVarsFor from things = take (length things) $ map T.singleton [from..]

elmFunctionDef :: (Req, ElmTypeVar) -> Text
elmFunctionDef (req, typevar) =
  T.unlines
    [ elmReqFunctionName req <> " : Config -> " <> elmReqSignature req typevar
    , elmReqFunctionName req <> " config decoder " <> T.intercalate " " (argNames req) <> " ="
    , "  Http.send config.settings"
    , "        { verb = \"" <> elmReqMethod req <> "\""
    , "        , headers = []"
    , "        , url = (config.baseURI ++ " <> elmReqPath req <> ")"
    , "        , body = Http.empty"
    , "        } |> Http.fromJson decoder"
    ]


type ElmTypeVar = Text
type ElmSignature = Text
type ElmFunctionName = Text

elmReqMethod :: Req -> Text
elmReqMethod req = req ^. reqMethod

elmReqFunctionName :: Req -> ElmFunctionName
elmReqFunctionName req = camelCase (req ^. funcName)

elmReqSignature :: Req -> ElmTypeVar -> ElmSignature
elmReqSignature req tvar = T.intercalate " -> " typeArgs
  where typeArgs = [ "Decode.Decoder " <> tvar] ++ captureTypes ++ ["Task.Task Http.Error " <> tvar]
        captureTypes = map (const "Int") (filter isCapture (segments req))

curriedFunctionField :: (Req, ElmTypeVar) -> Text
curriedFunctionField (req, typevar) = elmReqFunctionName req <> " : " <> elmReqSignature req typevar

elmReqPath :: Req -> Text
elmReqPath req = "\"/\" ++ " <> T.intercalate " ++ \"/\"  ++ " (map segmentAsElm (segments req))
  where segmentAsElm seg =
          case seg ^. segment of
            (Static s) -> "\"" <> s <> "\""
            (Cap arg)  -> "(toString " <> elmArgName arg <> ")"

argNames :: Req -> [Text]
argNames req = map extractArgName (filter isCapture (segments req))
  where
    extractArgName seg =
      case seg ^. segment of
        (Cap arg) -> elmArgName arg
        _ -> undefined

segments :: Req -> [Segment]
segments req = req ^. reqUrl ^. path

elmArgName :: (Text, Text) -> Text
elmArgName (name, _) = camelCase ["arg", name]

# LANGUAGE DataKinds             #
# LANGUAGE FlexibleContexts      #
# LANGUAGE TypeOperators         #
 TODO: allow user to pass output module name
# LANGUAGE FlexibleInstances      #
# LANGUAGE MultiParamTypeClasses #
# LANGUAGE OverloadedStrings      #

module Servant.Elm
       ( elmForAPI
       , GenerateList(..)
       , NoTypes
       , HasForeign(..)
       , HasForeignType(..)
  ) where

import           Control.Lens    ((^.))
import           Data.Monoid
import           Data.Proxy
import           Data.Text       (Text)
import qualified Data.Text       as T
import           Servant.Foreign


elmForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
         => Proxy api
         -> Text
elmForAPI p = generateElm (listFromAPI (Proxy :: Proxy NoTypes) p)


generateElm :: [Req] -> Text
generateElm reqs =
  T.unlines
    [ "-- Generated by servant-elm"
    , "module API where"
    , ""
    , "import Http"
    , "import Task"
    , "import Json.Decode as Decode"
    , ""
    , "type alias Config = {"
    , "    baseURI : String"
    , "  , settings : Http.Settings"
    , "  }"
    , ""
    , "type alias " <> apiType <> " = {"
    , commaSepLines (map curriedFunctionField reqsAndTypeVars)
    , "  }"
    , ""
    , "getAPI : Config -> " <> apiType
    , "getAPI config = {"
    , commaSepLines [elmReqFunctionName req <> " = " <> elmReqFunctionName req <> " config"  | req <- reqs]
    , "  }"
    , ""
    , ""
    , T.intercalate "\n\n" (map elmFunctionDef reqsAndTypeVars)
    ]
  where
    commaSepLines xs = "    " <>  T.intercalate "\n  , " xs
    apiType = "API " <> T.intercalate " " returnTypeVars
    returnTypeVars = typeVarsFor 'a' reqs
    reqsAndTypeVars = zip reqs returnTypeVars


typeVarsFor :: Char -> [a] -> [ElmTypeVar]
typeVarsFor from things = take (length things) $ map T.singleton [from..]

elmFunctionDef :: (Req, ElmTypeVar) -> Text
elmFunctionDef (req, typevar) =
  T.unlines
    [ elmReqFunctionName req <> " : Config -> " <> elmReqSignature req typevar
    , elmReqFunctionName req <> " config decoder " <> T.intercalate " " (argNames req) <> " ="
    , "  Http.send config.settings"
    , "        { verb = \"" <> elmReqMethod req <> "\""
    , "        , headers = []"
    , "        , url = (config.baseURI ++ " <> elmReqPath req <> ")"
    , "        , body = Http.empty"
    , "        } |> Http.fromJson decoder"
    ]


type ElmTypeVar = Text
type ElmSignature = Text
type ElmFunctionName = Text

elmReqMethod :: Req -> Text
elmReqMethod req = req ^. reqMethod

elmReqFunctionName :: Req -> ElmFunctionName
elmReqFunctionName req = camelCase (req ^. funcName)

elmReqSignature :: Req -> ElmTypeVar -> ElmSignature
elmReqSignature req tvar = T.intercalate " -> " typeArgs
  where typeArgs = [ "Decode.Decoder " <> tvar] ++ captureTypes ++ ["Task.Task Http.Error " <> tvar]
        captureTypes = map (const "Int") (filter isCapture (segments req))

curriedFunctionField :: (Req, ElmTypeVar) -> Text
curriedFunctionField (req, typevar) = elmReqFunctionName req <> " : " <> elmReqSignature req typevar

elmReqPath :: Req -> Text
elmReqPath req = "\"/\" ++ " <> T.intercalate " ++ \"/\"  ++ " (map segmentAsElm (segments req))
  where segmentAsElm seg =
          case seg ^. segment of
            (Static s) -> "\"" <> s <> "\""
            (Cap arg)  -> "(toString " <> elmArgName arg <> ")"

argNames :: Req -> [Text]
argNames req = map extractArgName (filter isCapture (segments req))
  where
    extractArgName seg =
      case seg ^. segment of
        (Cap arg) -> elmArgName arg
        _ -> undefined

segments :: Req -> [Segment]
segments req = req ^. reqUrl ^. path

elmArgName :: (Text, Text) -> Text
elmArgName (name, _) = camelCase ["arg", name]
