From 7d9523eed1dd9cc91138dfeed3d90010ecc82136 Mon Sep 17 00:00:00 2001
From: aaron levin <aaron.levin@soundcloud.com>
Date: Mon, 21 Dec 2015 23:35:10 +0100
Subject: [PATCH] Fix servant-foreign rebasing + update API

---
 servant-foreign/src/Servant/Foreign.hs        | 271 ------------------
 .../src/Servant/Foreign/Internal.hs           |  33 ++-
 2 files changed, 31 insertions(+), 273 deletions(-)

diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs
index 7aa2e2ba..5054e69f 100644
--- a/servant-foreign/src/Servant/Foreign.hs
+++ b/servant-foreign/src/Servant/Foreign.hs
@@ -37,274 +37,3 @@ module Servant.Foreign
 
 import Servant.API
 import Servant.Foreign.Internal
-import           Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
-import qualified Data.Char    as C
-import           Data.Monoid ((<>))
-import           Data.Proxy
-import           Data.Text
-import           GHC.Exts     (Constraint)
-import           GHC.TypeLits
-import           Prelude      hiding (concat)
-import           Servant.API
-import Servant.API.Authentication
-
--- | Function name builder that simply concat each part together
-concatCase :: FunctionName -> Text
-concatCase = concat
-
--- | Function name builder using the snake_case convention.
--- each part is separated by a single underscore character.
-snakeCase :: FunctionName -> Text
-snakeCase = intercalate "_"
-
--- | Function name builder using the CamelCase convention.
--- each part begins with an upper case character.
-camelCase :: FunctionName -> Text
-camelCase = camelCase' . Prelude.map (replace "-" "")
-  where camelCase' []     = ""
-        camelCase' (p:ps) = concat $ p : Prelude.map capitalize ps
-        capitalize ""   = ""
-        capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
-
-type Arg = Text
-
-newtype Segment = Segment { _segment :: SegmentType  }
-  deriving (Eq, Show)
-
-data SegmentType = Static Text  -- ^ a static path segment. like "/foo"
-                 | Cap Arg        -- ^ a capture. like "/:userid"
-  deriving (Eq, Show)
-
-type Path = [Segment]
-
-data ArgType =
-    Normal
-  | Flag
-  | List
-  deriving (Eq, Show)
-
-data QueryArg = QueryArg
-  { _argName :: Arg
-  , _argType :: ArgType
-  } deriving (Eq, Show)
-
-data HeaderArg = HeaderArg
-    { headerArgName :: Text
-    }
-  | ReplaceHeaderArg
-    { headerArgName :: Text
-    , headerPattern :: Text
-  | HeaderArgGen
-    { headerArgName    :: Text
-    , headerArgGenBody :: (Text -> Text)
-    }
-    deriving (Eq, Show)
-
-data Url = Url
-  { _path     :: Path
-  , _queryStr :: [QueryArg]
-  } deriving (Eq, Show)
-
-defUrl :: Url
-defUrl = Url [] []
-
-type FunctionName = [Text]
-type Method = Text
-
-data Req = Req
-  { _reqUrl     :: Url
-  , _reqMethod  :: Method
-  , _reqHeaders :: [HeaderArg]
-  , _reqBody    :: Bool
-  , _funcName   :: FunctionName
-  }
-
-makeLenses ''QueryArg
-makeLenses ''Segment
-makeLenses ''Url
-makeLenses ''Req
-
-isCapture :: Segment -> Bool
-isCapture (Segment (Cap _)) = True
-isCapture                _  = False
-
-captureArg :: Segment -> Arg
-captureArg (Segment (Cap s)) = s
-captureArg                 _ = error "captureArg called on non capture"
-
-defReq :: Req
-defReq = Req defUrl "GET" [] False []
-
--- | To be used exclusively as a "negative" return type/constraint
--- by @'Elem`@ type family.
-class NotFound
-
-type family Elem (a :: *) (ls::[*]) :: Constraint where
-  Elem a '[]         = NotFound
-  Elem a (a ': list) = ()
-  Elem a (b ': list) = Elem a list
-
-class HasForeign (layout :: *) where
-  type Foreign layout :: *
-  foreignFor :: Proxy layout -> Req -> Foreign layout
-
-instance (HasForeign a, HasForeign b)
-      => HasForeign (a :<|> b) where
-  type Foreign (a :<|> b) = Foreign a :<|> Foreign b
-
-  foreignFor Proxy req =
-         foreignFor (Proxy :: Proxy a) req
-    :<|> foreignFor (Proxy :: Proxy b) req
-
-instance (KnownSymbol sym, HasForeign sublayout)
-      => HasForeign (Capture sym a :> sublayout) where
-  type Foreign (Capture sym a :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Cap str)]
-          & funcName %~ (++ ["by", str])
-
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
-
-instance Elem JSON list => HasForeign (Delete list a) where
-  type Foreign (Delete list a) = Req
-
-  foreignFor Proxy req =
-    req & funcName  %~ ("delete" :)
-        & reqMethod .~ "DELETE"
-
-instance Elem JSON list => HasForeign (Get list a) where
-  type Foreign (Get list a) = Req
-
-  foreignFor Proxy req =
-    req & funcName  %~ ("get" :)
-        & reqMethod .~ "GET"
-
-instance (KnownSymbol sym, HasForeign sublayout)
-      => HasForeign (Header sym a :> sublayout) where
-  type Foreign (Header sym a :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
-
-    where hname = pack . symbolVal $ (Proxy :: Proxy sym)
-          subP = Proxy :: Proxy sublayout
-
-instance (HasForeign sublayout)
-      => HasForeign (AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout) where
-  type Foreign (AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) (req & reqHeaders <>~
-      [HeaderArgGen "Authorization" ( \authdata ->
-        "(function("<>authdata<>"){" <>
-        "return \"Basic \" + btoa("<>authdata<>".username+\":\"+"<>authdata <> ".password)" <>
-        "})("<>authdata<>")")
-      ])
-  
-instance (HasForeign sublayout)
-      => HasForeign (AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout) where
-  type Foreign (AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) (req & reqHeaders <>~
-      [HeaderArgGen "Authorization" $ \authdata ->
-        "(function(" <> authdata <> "){" <>
-        "return \"Bearer \" + "<> authdata <> ";" <>
-        "})(" <> authdata<>")"
-      ])
-
-instance Elem JSON list => HasForeign (Post list a) where
-  type Foreign (Post list a) = Req
-
-  foreignFor Proxy req =
-    req & funcName  %~ ("post" :)
-        & reqMethod .~ "POST"
-
-instance Elem JSON list => HasForeign (Put list a) where
-  type Foreign (Put list a) = Req
-
-  foreignFor Proxy req =
-    req & funcName  %~ ("put" :)
-        & reqMethod .~ "PUT"
-
-instance (KnownSymbol sym, HasForeign sublayout)
-      => HasForeign (QueryParam sym a :> sublayout) where
-  type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str Normal]
-
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
-
-instance (KnownSymbol sym, HasForeign sublayout)
-      => HasForeign (QueryParams sym a :> sublayout) where
-  type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str List]
-
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
-
-instance (KnownSymbol sym, HasForeign sublayout)
-      => HasForeign (QueryFlag sym :> sublayout) where
-  type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqUrl.queryStr <>~ [QueryArg str Flag]
-
-    where str = pack . symbolVal $ (Proxy :: Proxy sym)
-
-instance HasForeign Raw where
-  type Foreign Raw = Method -> Req
-
-  foreignFor Proxy req method =
-    req & funcName %~ ((toLower method) :)
-        & reqMethod .~ method
-
-instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
-  type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqBody .~ True
-
-instance (KnownSymbol path, HasForeign sublayout)
-      => HasForeign (path :> sublayout) where
-  type Foreign (path :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Static str)]
-          & funcName %~ (++ [str])
-
-    where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
-
-instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
-  type Foreign (RemoteHost :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
-
-instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where
-  type Foreign (IsSecure :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
-
-instance HasForeign sublayout => HasForeign (Vault :> sublayout) where
-  type Foreign (Vault :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
-
-instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where
-  type Foreign (HttpVersion :> sublayout) = Foreign sublayout
-
-  foreignFor Proxy req =
-    foreignFor (Proxy :: Proxy sublayout) req
->>>>>>> 29b4dd5... Add support for authentication to servant-foreign and servant-js
diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs
index 27f0e411..706afd7a 100644
--- a/servant-foreign/src/Servant/Foreign/Internal.hs
+++ b/servant-foreign/src/Servant/Foreign/Internal.hs
@@ -20,12 +20,14 @@ module Servant.Foreign.Internal where
 
 import           Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
 import qualified Data.Char    as C
+import           Data.Monoid ((<>))
 import           Data.Proxy
 import           Data.Text
 import           GHC.Exts     (Constraint)
 import           GHC.TypeLits
 import           Prelude      hiding (concat)
 import           Servant.API
+import           Servant.API.Authentication
 
 -- | Function name builder that simply concat each part together
 concatCase :: FunctionName -> Text
@@ -74,7 +76,11 @@ data HeaderArg = HeaderArg
   | ReplaceHeaderArg
     { headerArg :: Arg
     , headerPattern :: Text
-    } deriving (Eq, Show)
+    }
+  | HeaderArgGen
+    { headerArgName    :: Text
+    , headerArgGenBody :: (Text -> Text)
+    }
 
 
 data Url = Url
@@ -95,7 +101,7 @@ data Req = Req
   , _reqBody       :: Maybe ForeignType
   , _reqReturnType :: ForeignType
   , _funcName      :: FunctionName
-  } deriving (Eq, Show)
+  }
 
 makeLenses ''QueryArg
 makeLenses ''Segment
@@ -347,3 +353,26 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res
 listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
 listFromAPI lang p = generateList (foreignFor lang p defReq)
 
+instance (HasForeign lang sublayout)
+      => HasForeign lang ((AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout)) where
+  type Foreign (AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
+
+  foreignFor _ Proxy req =
+    foreignFor (Proxy :: Proxy lang) (Proxy :: Proxy sublayout) (req & reqHeaders <>~
+      [HeaderArgGen "Authorization" ( \authdata ->
+        "(function("<>authdata<>"){" <>
+        "return \"Basic \" + btoa("<>authdata<>".username+\":\"+"<>authdata <> ".password)" <>
+        "})("<>authdata<>")")
+      ])
+  
+instance (HasForeign lang sublayout)
+      => HasForeign lang ((AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout)) where
+  type Foreign (AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
+
+  foreignFor _ Proxy req =
+    foreignFor (Proxy :: Proxy lang) (Proxy :: Proxy sublayout) (req & reqHeaders <>~
+      [HeaderArgGen "Authorization" $ \authdata ->
+        "(function(" <> authdata <> "){" <>
+        "return \"Bearer \" + "<> authdata <> ";" <>
+        "})(" <> authdata<>")"
+      ])