yesod-raml-bin-0.1.2: main.hs

{-# LANGUAGE OverloadedStrings #-}

import Yesod.Raml.Type
import Yesod.Raml.Routes
import Yesod.Raml.Docs
import Yesod.Raml.Mock
import qualified Data.Yaml as Y
import qualified Data.Text as TS
import qualified Data.Text.Encoding as TS
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Text.Blaze.Html.Renderer.Text
import Options.Applicative

import Yesod.Routes.TH.Types
import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types.Status
import Network.HTTP.Types.Header
import Data.Maybe

data Command =
    ToRoute FilePath FilePath
  | ToHtml FilePath FilePath
  | ToMock FilePath FilePath
  | MockServer Port FilePath
  | Verify FilePath

toroute :: Parser Command
toroute = ToRoute
         <$> (argument str (metavar "RamlFile"))
         <*> (argument str (metavar "RouteFile"))

tohtml :: Parser Command
tohtml = ToHtml
         <$> (argument str (metavar "RamlFile"))
         <*> (argument str (metavar "HtmlFile"))

tomock :: Parser Command
tomock = ToMock
         <$> (argument str (metavar "RamlFile"))
         <*> (argument str (metavar "MockFile"))

mockServer :: Parser Command
mockServer = MockServer
         <$> option auto (long "port"
                          <> short 'p'
                          <> value 3000
                          <> metavar "port")
         <*> (argument str (metavar "RamlFile"))

parse :: Parser Command
parse = subparser $ 
        command "toroute" (info toroute (progDesc "convert raml-file to route-file")) <>
        command "tohtml" (info tohtml (progDesc "convert raml-file to html-file")) <>
        command "tomock" (info tomock (progDesc "convert raml-file to mock-file")) <>
        command "mock-server" (info mockServer (progDesc "run mock-server")) <>
        command "verify" (info verify (progDesc "verify raml-file"))

verify :: Parser Command
verify = Verify <$> (argument str (metavar "RamlFile"))


runCmd :: Command -> IO ()
runCmd (ToRoute ifile ofile) = do
  v <- Y.decodeFileEither ifile :: IO (Either Y.ParseException Raml)
  case v of
    Left e -> print (show e)
    Right raml' ->  do
      case routesFromRaml raml' of
        Left e -> print (show e)
        Right routes ->  T.writeFile ofile (T.fromStrict (toYesodRoutes routes))

runCmd (ToHtml ifile ofile) = do
  v <- Y.decodeFileEither ifile :: IO (Either Y.ParseException Raml)
  case v of
    Left e -> print (show e)
    Right raml' -> T.writeFile ofile (renderHtml (htmlFromRaml raml'))

runCmd (ToMock ifile ofile) = do
  v <- Y.decodeFileEither ifile :: IO (Either Y.ParseException Raml)
  case v of
    Left e -> print (show e)
    Right raml' ->  do
      mockSrcFromRaml raml' >>= writeFile ofile

runCmd (Verify file) = do
  v <- Y.decodeFileEither file :: IO (Either Y.ParseException Raml)
  print v
      
runCmd (MockServer port ifile) = do
  v <- Y.decodeFileEither ifile :: IO (Either Y.ParseException Raml)
  case v of
    Left e -> print (show e)
    Right raml' ->  do
      case routesFromRaml raml' of
        Left e' ->  print (show e')
        Right routes ->  run port (app routes)

comparePath ::  [Piece String] ->  [TS.Text] ->  Bool
comparePath [] [] = True
comparePath [] (_:_) = False
comparePath (_:_)  [] = False
comparePath (Static str:xs) (str':xs') = if (TS.pack str) == str' then comparePath xs xs' else False
comparePath (Dynamic _:xs)  (_:xs') = comparePath xs xs'


app ::  [RouteEx] ->  Application
app routes req respond = do
  let method = requestMethod req
      paths = pathInfo req
      mexample = do
        r <-  listToMaybe $ filter (\r ->  comparePath (re_pieces r) paths)  $ routes
        methodex <-  listToMaybe $ filter  (\m ->  me_method m ==  BC.unpack method ) $ re_methods r
        me_example methodex
  case mexample of
    Nothing ->  respond $ responseLBS status400 [] ""
    Just (ctype,val) ->  respond $ responseLBS status200 [(hContentType,TS.encodeUtf8 ctype)] $ BL.fromStrict $ TS.encodeUtf8 val

opts :: ParserInfo Command
opts = info (parse <**> helper) idm
  
main :: IO ()
main = execParser opts >>= runCmd