{-# 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.Except(ExceptT(ExceptT))
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@
  -> ExceptT e IO a
getWith path d auth query fragment =
  ExceptT (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@
  -> ExceptT e IO Status
getStatusWith =
  getWith "/getStatus"

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

getStatus' ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> ExceptT 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@
  -> ExceptT e IO Settings
getSettingsWith =
  getWith "/getSettings"

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

getSettings' ::
  URIAuth -- ^ authority @\/\/anonymous\@www.haskell.org:42@
  -> String -- ^ query @?query@
  -> String -- ^ fragment @#frag@
  -> ExceptT 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@
  -> ExceptT e IO Situation
getSituationWith =
  getWith "/getSituation"

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

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