{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeOperators              #-}

{-# OPTIONS_GHC -fno-warn-unused-binds#-}

module Servant.Zeppelin.ClientSpec (spec) where

import           Control.Monad.Except
import           Data.Aeson
import           Data.Either
import qualified Data.List                as L
import           Data.Singletons.Prelude hiding ((:>))
import           Data.String.Conversions
import           GHC.Generics
import           Servant.Server
import           Servant.Zeppelin
import           Servant.Zeppelin.Client
import           Servant.Zeppelin.Server

import           Network.Wai.Handler.Warp (testWithApplication)
import           System.IO.Unsafe         (unsafePerformIO)


import           Network.HTTP.Client      (Manager, defaultManagerSettings,
                                           newManager)
import           Servant
import           Servant.Client
import           Test.Hspec
import           Test.QuickCheck


spec :: Spec
spec = do
  hasClientSpec
  return ()

hasClientSpec :: Spec
hasClientSpec = describe "HasClient" $ around (testWithApplication $ return app) $ do

  it "succeeds when we ask for the inflated data" $ \port -> quickCheckWith qcArgs $ property
                                                  $ \aid -> do
    ealbum <- getAlbumClientFull mgr (BaseUrl Http "localhost" port "") aid
    let Just (album, person, photos) = do
          a <- getAlbumById aid
          p <- getPersonById (albumOwner a)
          let phs = getPhotosByIds (albumPhotos a)
          return (a, p, phs)
    ealbum `shouldSatisfy` isRight
    let Right (SideLoaded a deps) = ealbum
    person `shouldBe` projectDependency deps
    photos `shouldBe` projectDependency deps
    a `shouldBe` album

  it "succeeds when we ask for the uninflated data" $ \port -> quickCheckWith qcArgs $ property
                                                    $ \aid -> do
    ealbum <- getAlbumClient mgr (BaseUrl Http "localhost" port "") aid
    ealbum `shouldSatisfy` isRight
    let Right album = ealbum
        Just album' = getAlbumById aid
    album `shouldBe` album'

qcArgs :: Args
qcArgs = stdArgs {maxSuccess = 20}

--------------------------------------------------------------------------------
-- | Client
--------------------------------------------------------------------------------

mgr :: Manager
mgr = unsafePerformIO $ newManager defaultManagerSettings
{-# NOINLINE mgr #-}

type AlbumDeps =  '[Person, [Photo]]

getAlbumClientFull :: Manager
                   -> BaseUrl
                   -> AlbumId
                   -> IO (Either ServantError (SideLoaded Album AlbumDeps))
getAlbumClientFull m burl aid =
  flip runClientM (ClientEnv m burl) $
    runDepClient (client api aid) STrue

getAlbumClient :: Manager
               -> BaseUrl
               -> AlbumId
               -> IO (Either ServantError Album)
getAlbumClient m burl aid =
  flip runClientM (ClientEnv m burl) $
    runDepClient (client api aid) SFalse

--------------------------------------------------------------------------------
-- | Application
--------------------------------------------------------------------------------

type API = "albums" :> Capture "albumId" AlbumId
                    :> Get '[JSON, PlainText] Album
                    :> SideLoad '[Person, [Photo]]

api :: Proxy API
api = Proxy @API

newtype QueryError = LookupError String

newtype DB a = DB { runDB :: ExceptT QueryError IO a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadError QueryError)

server :: ServerT API Handler
server = albumHandler

albumHandler :: AlbumId -> Handler Album
albumHandler aid =
  case L.find (\album -> albumId album == aid) albumTable of
    Nothing    -> throwError err404
    Just album -> return album

phi :: DB :~> Handler
phi = NT $ \ha -> do
  ea <- liftIO . runExceptT . runDB $ ha
  case ea of
    Left (LookupError msg) -> throwError err404 {errBody = cs msg}
    Right a                -> return a

app :: Application
app = serveWithContext api ctxt server
  where
    ctxt :: Context '[DB :~> Handler]
    ctxt = phi :. EmptyContext

--------------------------------------------------------------------------------
-- | Data
--------------------------------------------------------------------------------
-- | Photo

newtype PhotoId = PhotoId Int
  deriving (Eq, Show, Num, Generic, ToJSON, FromJSON)

type instance NamedDependency [Photo] = "photos"
type instance NamedDependency [PhotoId] = "photoIds"

data Photo =
  Photo { photoId      :: PhotoId
        , photoCaption :: String
        , artistId     :: PersonId
        } deriving (Eq, Show, Generic)

instance ToJSON Photo
instance FromJSON Photo

photosTable :: [Photo]
photosTable = [ Photo 1 "At the Beach." 1
              , Photo 2 "At the Mountain." 1
              , Photo 3 "With Friends." 1
              , Photo 4 "Bow Wow." 2
              ]

getPhotosByIds :: [PhotoId] -> [Photo]
getPhotosByIds pids = filter (\photo -> photoId photo `elem` pids) photosTable

instance Inflatable DB [PhotoId] where
  type Full DB [PhotoId] = [Photo]
  inflator = return . getPhotosByIds

-- | Person

newtype PersonId = PersonId Int
  deriving (Eq, Show, Num, Generic, ToJSON, FromJSON)

type instance NamedDependency Person = "person"

data Person =
  Person { personId   :: PersonId
         , personName :: String
         } deriving (Eq, Show, Generic)

instance ToJSON Person
instance FromJSON Person

personTable :: [Person]
personTable = [ Person 1 "Alice"
              , Person 2 "Fido"
              ]

getPersonById :: PersonId -> Maybe Person
getPersonById pid = L.find (\person -> personId person == pid) personTable

instance Inflatable DB PersonId where
  type Full DB PersonId = Person
  inflator pid =
    case getPersonById pid of
      Nothing -> throwError . LookupError $ "Could not find person with id: " <> show pid
      Just person -> return person

-- | Albums

newtype AlbumId = AlbumId Int
  deriving (Eq, Show, Num, ToJSON, FromJSON, FromHttpApiData, ToHttpApiData)

instance Arbitrary AlbumId where
  arbitrary = elements $ map AlbumId [1..3]

data Album =
  Album { albumId     :: AlbumId
        , albumName   :: String
        , albumOwner  :: PersonId
        , albumPhotos :: [PhotoId]
        } deriving (Eq, Show, Generic)

instance ToJSON Album
instance FromJSON Album

albumTable :: [Album]
albumTable = [ Album 1 "Vacations" 1 [1,2]
             , Album 2 "In the City" 1 [3]
             , Album 3 "Howl" 2 [4]
             ]

getAlbumById :: AlbumId -> Maybe Album
getAlbumById aid = L.find (\album -> albumId album == aid) albumTable

instance HasDependencies DB Album '[PersonId, [PhotoId]] where
  getDependencies (Album _ _ owner pIds) = owner :&: pIds :&: NilDeps

instance MimeRender PlainText Album where
  mimeRender _ _ = "Album"