{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Aviation.Stratux.HTTP(
  getWith
, getStatusWith
, getStatus
, getStatus'
, getSettingsWith
, getSettings
, getSettings'
, setSettings
, getSituation
, getSituation'
) where

import Control.Applicative((<$>))
import Control.Monad((>>=))
import Control.Monad.Trans.Either(EitherT(EitherT))
import Data.Aeson(eitherDecode, eitherDecode', encode)
import Data.Aviation.Stratux.Types.Status(Status)
import Data.Aviation.Stratux.Types.Settings(Settings, SettingsSet)
import Data.Aviation.Stratux.Types.Situation(Situation)
import qualified Data.ByteString.Lazy.UTF8 as BLU
import Data.Either(Either)
import Data.Maybe(Maybe(Just))
import Data.String(String)
import Network.HTTP(RequestMethod(GET, POST), simpleHTTP, mkRequest, getResponseBody, setRequestBody)
import Network.TCP(HStream)
import Network.URI(URI(URI), URIAuth)
import System.IO(IO)

httpGet :: 
  HStream b =>
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ @\/ghc@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@    
  -> IO b
httpGet auth path query fragment =
  simpleHTTP (mkRequest GET (URI "http:" (Just auth) path query fragment)) >>= getResponseBody

getWith :: 
  HStream x =>
  String -- ^ @\/ghc@
  -> (x -> Either e a)
  -> URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT e IO a
getWith path d auth query fragment =
  EitherT (d <$> httpGet auth path query fragment)

getStatusWith :: 
  HStream x =>
  (x -> Either e Status)
  -> URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT e IO Status
getStatusWith =
  getWith "/getStatus"

getStatus ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Status
getStatus =
  getStatusWith eitherDecode

getStatus' ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Status
getStatus' =
  getStatusWith eitherDecode'

getSettingsWith :: 
  HStream x =>
  (x -> Either e Settings)
  -> URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT e IO Settings
getSettingsWith =
  getWith "/getSettings"

getSettings ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Settings
getSettings =
  getSettingsWith eitherDecode

getSettings' ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Settings
getSettings' =
  getSettingsWith eitherDecode'

httpPost ::
  String
  -> String
  -> URIAuth
  -> String
  -> String
  -> String
  -> IO String
httpPost typ body auth path query fragment =
  simpleHTTP (setRequestBody (mkRequest POST (URI "http:" (Just auth) path query fragment)) (typ, body)) >>= getResponseBody

setSettings :: 
  SettingsSet
  -> URIAuth
  -> String
  -> String
  -> IO String
setSettings s auth =
  httpPost "application/json" (BLU.toString (encode s)) auth "/setSettings"

getSituationWith :: 
  HStream x =>
  (x -> Either e Situation)
  -> URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT e IO Situation
getSituationWith =
  getWith "/getSituation"

getSituation ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Situation
getSituation =
  getSituationWith eitherDecode

getSituation' ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> EitherT String IO Situation
getSituation' =
  getSituationWith eitherDecode'