Lackey.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Lackey
  ( rubyForAPI
  ) where

import qualified Data.Char as Char
import Data.Function ((&))
import qualified Data.Maybe as Maybe
import qualified Data.Proxy as Proxy
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Servant.Foreign as Servant

type Language = Servant.NoTypes

languageProxy :: Proxy.Proxy Language
languageProxy = Proxy.Proxy

type Request = Servant.NoContent

requestProxy :: Proxy.Proxy Request
requestProxy = Proxy.Proxy

renderRequests :: [Servant.Req Request] -> Text.Text
renderRequests requests = requests & fmap renderRequest & Text.intercalate ";"

functionName :: Servant.Req Request -> Text.Text
functionName request = request & Servant._reqFuncName & Servant.snakeCase

hasBody :: Servant.Req Request -> Bool
hasBody request = case Servant._reqBody request of
  Nothing -> False
  Just _ -> True

bodyArgument :: Text.Text
bodyArgument = "body"

underscore :: Text.Text -> Text.Text
underscore text =
  text & Text.toLower & Text.map (\c -> if Char.isAlphaNum c then c else '_')

getHeaders :: Servant.Req Request -> [Text.Text]
getHeaders request =
  request
    & Servant._reqHeaders
    & Maybe.mapMaybe
        (\h -> case h of
          Servant.HeaderArg x -> Just x
          Servant.ReplaceHeaderArg _ _ -> Nothing
        )
    & fmap (Servant.unPathSegment . Servant._argName)

getURLPieces :: Servant.Req Request -> [Either Text.Text Text.Text]
getURLPieces request =
  let
    url = request & Servant._reqUrl
    path =
      url
        & Servant._path
        & Maybe.mapMaybe
            ((\segment -> case segment of
               Servant.Static _ -> Nothing
               Servant.Cap arg -> Just arg
             )
            . Servant.unSegment
            )
        & fmap (Servant.unPathSegment . Servant._argName)
    query = url & Servant._queryStr & fmap
      (Servant.unPathSegment . Servant._argName . Servant._queryArgName)
  in fmap Left path <> fmap Right query

functionArguments :: Servant.Req Request -> Text.Text
functionArguments request = Text.concat
  [ "("
  , [ [Just "excon"]
    , request & getURLPieces & fmap
      (\piece -> Just $ case piece of
        Left capture -> underscore capture
        Right param -> underscore param <> ": nil"
      )
    , request & getHeaders & fmap (Just . (<> ": nil") . underscore)
    , [if hasBody request then Just bodyArgument else Nothing]
    ]
  & concat
  & Maybe.catMaybes
  & Text.intercalate ","
  , ")"
  ]

requestMethod :: Servant.Req Request -> Text.Text
requestMethod request =
  request & Servant._reqMethod & Text.decodeUtf8 & Text.toLower & Text.cons ':'

requestPath :: Servant.Req Request -> Text.Text
requestPath request =
  let
    path =
      request
        & Servant._reqUrl
        & Servant._path
        & fmap
            ((\x -> case x of
               Servant.Static y -> Servant.unPathSegment y
               Servant.Cap y ->
                 let
                   z =
                     y & Servant._argName & Servant.unPathSegment & underscore
                 in "#{" <> z <> "}"
             )
            . Servant.unSegment
            )
        & Text.intercalate "/"
    query =
      request
        & Servant._reqUrl
        & Servant._queryStr
        & fmap
            ((\x -> x <> "=#{" <> underscore x <> "}")
            . Servant.unPathSegment
            . Servant._argName
            . Servant._queryArgName
            )
        & Text.intercalate "&"
    url = "/" <> path <> (if Text.null query then "" else "?" <> query)
  in "\"" <> url <> "\""

requestHeaders :: Servant.Req Request -> Text.Text
requestHeaders request =
  [ ["{"]
    , request & getHeaders & fmap (\x -> "\"" <> x <> "\"=>" <> underscore x)
    , ["}"]
    ]
    & concat
    & Text.concat

requestBody :: Servant.Req Request -> Text.Text
requestBody request = if hasBody request then bodyArgument else "nil"

functionBody :: Servant.Req Request -> Text.Text
functionBody request = Text.concat
  [ "excon.request("
  , ":method=>"
  , requestMethod request
  , ","
  , ":path=>"
  , requestPath request
  , ","
  , ":headers=>"
  , requestHeaders request
  , ","
  , ":body=>"
  , requestBody request
  , ")"
  ]

renderRequest :: Servant.Req Request -> Text.Text
renderRequest request = Text.concat
  [ "def "
  , functionName request
  , functionArguments request
  , functionBody request
  , "end"
  ]

requestsForAPI
  :: ( Servant.HasForeign Language Request api
     , Servant.GenerateList Request (Servant.Foreign Request api)
     )
  => Proxy.Proxy api
  -> [Servant.Req Request]
requestsForAPI api = api & Servant.listFromAPI languageProxy requestProxy

rubyForAPI
  :: ( Servant.HasForeign Language Request api
     , Servant.GenerateList Request (Servant.Foreign Request api)
     )
  => Proxy.Proxy api
  -> Text.Text
rubyForAPI api = api & requestsForAPI & renderRequests