module Rest.Driver.Snap (apiToHandler, apiToHandler') where
import Safe
import Snap.Core
import Snap.Util.FileServe (defaultMimeTypes)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as M
import qualified Network.URI.Encode as URI
import qualified Snap.Core as Snap
import Rest.Api (Api)
import Rest.Driver.Perform (Rest (..))
import Rest.Driver.Types (Run)
import qualified Rest.Run as Rest
import qualified Rest.Driver.Types as Rest
apiToHandler :: Api Snap -> Snap ()
apiToHandler = apiToHandler' id
apiToHandler' :: Run m Snap -> Api m -> Snap ()
apiToHandler' run api = Rest.apiToHandler' run api >>= writeLBS
instance Rest Snap where
getHeader nm = getsRequest (fmap UTF8.toString . Snap.getHeader (CI.mk . UTF8.fromString $ nm))
getParameter nm = getsRequest (fmap UTF8.toString . (>>= headMay) . rqParam (UTF8.fromString nm))
getBody = readRequestBody (1 * 1024 * 1024)
getMethod = getsRequest (toRestMethod . rqMethod)
getPaths = getsRequest (map (UTF8.toString . URI.decodeByteString) . Char8.split '/' . rqPathInfo)
lookupMimeType = return . fmap UTF8.toString . flip M.lookup defaultMimeTypes
setHeader nm v = modifyResponse (Snap.setHeader (CI.mk . UTF8.fromString $ nm) (UTF8.fromString v))
setResponseCode cd = modifyResponse (Snap.setResponseCode cd)
toRestMethod :: Snap.Method -> Rest.Method
toRestMethod Snap.GET = Rest.GET
toRestMethod Snap.POST = Rest.POST
toRestMethod Snap.PUT = Rest.PUT
toRestMethod Snap.DELETE = Rest.DELETE
toRestMethod mthd = Rest.Unknown (show mthd)