{-# 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 Language
languageProxy = Proxy Language
forall k (t :: k). Proxy t
Proxy.Proxy

type Request = Servant.NoContent

requestProxy :: Proxy.Proxy Request
requestProxy :: Proxy Request
requestProxy = Proxy Request
forall k (t :: k). Proxy t
Proxy.Proxy

renderRequests :: [Servant.Req Request] -> Text.Text
renderRequests :: [Req Request] -> Text
renderRequests [Req Request]
requests = [Req Request]
requests [Req Request] -> ([Req Request] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Req Request -> Text) -> [Req Request] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Req Request -> Text
renderRequest [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
";"

functionName :: Servant.Req Request -> Text.Text
functionName :: Req Request -> Text
functionName Req Request
request = Req Request
request Req Request -> (Req Request -> FunctionName) -> FunctionName
forall a b. a -> (a -> b) -> b
& Req Request -> FunctionName
forall f. Req f -> FunctionName
Servant._reqFuncName FunctionName -> (FunctionName -> Text) -> Text
forall a b. a -> (a -> b) -> b
& FunctionName -> Text
Servant.snakeCase

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

bodyArgument :: Text.Text
bodyArgument :: Text
bodyArgument = Text
"body"

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

getHeaders :: Servant.Req Request -> [Text.Text]
getHeaders :: Req Request -> [Text]
getHeaders Req Request
request =
  Req Request
request Req Request
-> (Req Request -> [HeaderArg Request]) -> [HeaderArg Request]
forall a b. a -> (a -> b) -> b
& Req Request -> [HeaderArg Request]
forall f. Req f -> [HeaderArg f]
Servant._reqHeaders [HeaderArg Request]
-> ([HeaderArg Request] -> [Arg Request]) -> [Arg Request]
forall a b. a -> (a -> b) -> b
&
  (HeaderArg Request -> Maybe (Arg Request))
-> [HeaderArg Request] -> [Arg Request]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
    (\HeaderArg Request
h ->
       case HeaderArg Request
h of
         Servant.HeaderArg Arg Request
x -> Arg Request -> Maybe (Arg Request)
forall a. a -> Maybe a
Just Arg Request
x
         Servant.ReplaceHeaderArg Arg Request
_ Text
_ -> Maybe (Arg Request)
forall a. Maybe a
Nothing) [Arg Request] -> ([Arg Request] -> [PathSegment]) -> [PathSegment]
forall a b. a -> (a -> b) -> b
&
  (Arg Request -> PathSegment) -> [Arg Request] -> [PathSegment]
forall a b. (a -> b) -> [a] -> [b]
map Arg Request -> PathSegment
forall f. Arg f -> PathSegment
Servant._argName [PathSegment] -> ([PathSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
  (PathSegment -> Text) -> [PathSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PathSegment -> Text
Servant.unPathSegment

getURLPieces :: Servant.Req Request -> [Either Text.Text Text.Text]
getURLPieces :: Req Request -> [Either Text Text]
getURLPieces Req Request
request =
  let url :: Url Request
url = Req Request
request Req Request -> (Req Request -> Url Request) -> Url Request
forall a b. a -> (a -> b) -> b
& Req Request -> Url Request
forall f. Req f -> Url f
Servant._reqUrl
      path :: [Text]
path =
        Url Request
url Url Request -> (Url Request -> Path Request) -> Path Request
forall a b. a -> (a -> b) -> b
& Url Request -> Path Request
forall f. Url f -> Path f
Servant._path Path Request
-> (Path Request -> [SegmentType Request]) -> [SegmentType Request]
forall a b. a -> (a -> b) -> b
& (Segment Request -> SegmentType Request)
-> Path Request -> [SegmentType Request]
forall a b. (a -> b) -> [a] -> [b]
map Segment Request -> SegmentType Request
forall f. Segment f -> SegmentType f
Servant.unSegment [SegmentType Request]
-> ([SegmentType Request] -> [Arg Request]) -> [Arg Request]
forall a b. a -> (a -> b) -> b
&
        (SegmentType Request -> Maybe (Arg Request))
-> [SegmentType Request] -> [Arg Request]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe
          (\SegmentType Request
segment ->
             case SegmentType Request
segment of
               Servant.Static PathSegment
_ -> Maybe (Arg Request)
forall a. Maybe a
Nothing
               Servant.Cap Arg Request
arg -> Arg Request -> Maybe (Arg Request)
forall a. a -> Maybe a
Just Arg Request
arg) [Arg Request] -> ([Arg Request] -> [PathSegment]) -> [PathSegment]
forall a b. a -> (a -> b) -> b
&
        (Arg Request -> PathSegment) -> [Arg Request] -> [PathSegment]
forall a b. (a -> b) -> [a] -> [b]
map Arg Request -> PathSegment
forall f. Arg f -> PathSegment
Servant._argName [PathSegment] -> ([PathSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (PathSegment -> Text) -> [PathSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PathSegment -> Text
Servant.unPathSegment
      query :: [Text]
query =
        Url Request
url Url Request
-> (Url Request -> [QueryArg Request]) -> [QueryArg Request]
forall a b. a -> (a -> b) -> b
& Url Request -> [QueryArg Request]
forall f. Url f -> [QueryArg f]
Servant._queryStr [QueryArg Request]
-> ([QueryArg Request] -> [Arg Request]) -> [Arg Request]
forall a b. a -> (a -> b) -> b
& (QueryArg Request -> Arg Request)
-> [QueryArg Request] -> [Arg Request]
forall a b. (a -> b) -> [a] -> [b]
map QueryArg Request -> Arg Request
forall f. QueryArg f -> Arg f
Servant._queryArgName [Arg Request] -> ([Arg Request] -> [PathSegment]) -> [PathSegment]
forall a b. a -> (a -> b) -> b
&
        (Arg Request -> PathSegment) -> [Arg Request] -> [PathSegment]
forall a b. (a -> b) -> [a] -> [b]
map Arg Request -> PathSegment
forall f. Arg f -> PathSegment
Servant._argName [PathSegment] -> ([PathSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (PathSegment -> Text) -> [PathSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PathSegment -> Text
Servant.unPathSegment
  in (Text -> Either Text Text) -> [Text] -> [Either Text Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text Text
forall a b. a -> Either a b
Left [Text]
path [Either Text Text] -> [Either Text Text] -> [Either Text Text]
forall a. [a] -> [a] -> [a]
++ (Text -> Either Text Text) -> [Text] -> [Either Text Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text Text
forall a b. b -> Either a b
Right [Text]
query

functionArguments :: Servant.Req Request -> Text.Text
functionArguments :: Req Request -> Text
functionArguments Req Request
request =
  [Text] -> Text
Text.concat
    [ Text
"("
    , [ [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"excon"]
      , Req Request
request Req Request
-> (Req Request -> [Either Text Text]) -> [Either Text Text]
forall a b. a -> (a -> b) -> b
& Req Request -> [Either Text Text]
getURLPieces [Either Text Text] -> ([Either Text Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (Either Text Text -> Text) -> [Either Text Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
          (\Either Text Text
piece ->
             case Either Text Text
piece of
               Left Text
capture -> Text -> Text
underscore Text
capture
               Right Text
param -> Text -> Text
underscore Text
param Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": nil") [Text] -> ([Text] -> [Maybe Text]) -> [Maybe Text]
forall a b. a -> (a -> b) -> b
&
        (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
forall a. a -> Maybe a
Just
      , Req Request
request Req Request -> (Req Request -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Req Request -> [Text]
getHeaders [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
underscore [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": nil") [Text] -> ([Text] -> [Maybe Text]) -> [Maybe Text]
forall a b. a -> (a -> b) -> b
& (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
forall a. a -> Maybe a
Just
      , [ if Req Request -> Bool
hasBody Req Request
request
            then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bodyArgument
            else Maybe Text
forall a. Maybe a
Nothing
        ]
      ] [[Maybe Text]] -> ([[Maybe Text]] -> [Maybe Text]) -> [Maybe Text]
forall a b. a -> (a -> b) -> b
&
      [[Maybe Text]] -> [Maybe Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Maybe Text] -> ([Maybe Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
      [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
Maybe.catMaybes [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
&
      Text -> [Text] -> Text
Text.intercalate Text
","
    , Text
")"
    ]

requestMethod :: Servant.Req Request -> Text.Text
requestMethod :: Req Request -> Text
requestMethod Req Request
request =
  Req Request
request Req Request -> (Req Request -> Method) -> Method
forall a b. a -> (a -> b) -> b
& Req Request -> Method
forall f. Req f -> Method
Servant._reqMethod Method -> (Method -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Method -> Text
Text.decodeUtf8 Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
Text.toLower Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Char -> Text -> Text
Text.cons Char
':'

requestPath :: Servant.Req Request -> Text.Text
requestPath :: Req Request -> Text
requestPath Req Request
request =
  let path :: Text
path =
        Req Request
request Req Request -> (Req Request -> Url Request) -> Url Request
forall a b. a -> (a -> b) -> b
& Req Request -> Url Request
forall f. Req f -> Url f
Servant._reqUrl Url Request -> (Url Request -> Path Request) -> Path Request
forall a b. a -> (a -> b) -> b
& Url Request -> Path Request
forall f. Url f -> Path f
Servant._path Path Request
-> (Path Request -> [SegmentType Request]) -> [SegmentType Request]
forall a b. a -> (a -> b) -> b
& (Segment Request -> SegmentType Request)
-> Path Request -> [SegmentType Request]
forall a b. (a -> b) -> [a] -> [b]
map Segment Request -> SegmentType Request
forall f. Segment f -> SegmentType f
Servant.unSegment [SegmentType Request]
-> ([SegmentType Request] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (SegmentType Request -> Text) -> [SegmentType Request] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map
          (\SegmentType Request
x ->
             case SegmentType Request
x of
               Servant.Static PathSegment
y -> PathSegment -> Text
Servant.unPathSegment PathSegment
y
               Servant.Cap Arg Request
y ->
                 let z :: Text
z =
                       Arg Request
y Arg Request -> (Arg Request -> PathSegment) -> PathSegment
forall a b. a -> (a -> b) -> b
& Arg Request -> PathSegment
forall f. Arg f -> PathSegment
Servant._argName PathSegment -> (PathSegment -> Text) -> Text
forall a b. a -> (a -> b) -> b
& PathSegment -> Text
Servant.unPathSegment Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
underscore
                 in Text
"#{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
z Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
&
        Text -> [Text] -> Text
Text.intercalate Text
"/"
      query :: Text
query =
        Req Request
request Req Request -> (Req Request -> Url Request) -> Url Request
forall a b. a -> (a -> b) -> b
& Req Request -> Url Request
forall f. Req f -> Url f
Servant._reqUrl Url Request
-> (Url Request -> [QueryArg Request]) -> [QueryArg Request]
forall a b. a -> (a -> b) -> b
& Url Request -> [QueryArg Request]
forall f. Url f -> [QueryArg f]
Servant._queryStr [QueryArg Request]
-> ([QueryArg Request] -> [Arg Request]) -> [Arg Request]
forall a b. a -> (a -> b) -> b
&
        (QueryArg Request -> Arg Request)
-> [QueryArg Request] -> [Arg Request]
forall a b. (a -> b) -> [a] -> [b]
map QueryArg Request -> Arg Request
forall f. QueryArg f -> Arg f
Servant._queryArgName [Arg Request] -> ([Arg Request] -> [PathSegment]) -> [PathSegment]
forall a b. a -> (a -> b) -> b
&
        (Arg Request -> PathSegment) -> [Arg Request] -> [PathSegment]
forall a b. (a -> b) -> [a] -> [b]
map Arg Request -> PathSegment
forall f. Arg f -> PathSegment
Servant._argName [PathSegment] -> ([PathSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (PathSegment -> Text) -> [PathSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PathSegment -> Text
Servant.unPathSegment [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
        (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=#{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
underscore Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}") [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
&
        Text -> [Text] -> Text
Text.intercalate Text
"&"
      url :: Text
url =
        Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (if Text -> Bool
Text.null Text
query
           then Text
""
           else Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
query)
  in Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

requestHeaders :: Servant.Req Request -> Text.Text
requestHeaders :: Req Request -> Text
requestHeaders Req Request
request =
  [ [Text
"{"]
  , Req Request
request Req Request -> (Req Request -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Req Request -> [Text]
getHeaders [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"=>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
underscore Text
x)
  , [Text
"}"]
  ] [[Text]] -> ([[Text]] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
&
  [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
&
  [Text] -> Text
Text.concat

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

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

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

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

rubyForAPI ::
     ( Servant.HasForeign Language Request api
     , Servant.GenerateList Request (Servant.Foreign Request api)
     )
  => Proxy.Proxy api
  -> Text.Text
rubyForAPI :: Proxy api -> Text
rubyForAPI Proxy api
api = Proxy api
api Proxy api -> (Proxy api -> [Req Request]) -> [Req Request]
forall a b. a -> (a -> b) -> b
& Proxy api -> [Req Request]
forall api.
(HasForeign Language Request api,
 GenerateList Request (Foreign Request api)) =>
Proxy api -> [Req Request]
requestsForAPI [Req Request] -> ([Req Request] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Req Request] -> Text
renderRequests