-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}

module FoundationSpec where

import TestImport

import ModelSpec ()

import Yesod.EmbeddedStatic

import Servant.QuickCheck.Internal.HasGenRequest (HasGenRequest(..))
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types.URI as URI

import Yesod.Servant (HasRoute(..), ServantApi, ServantApiUnproxy')

import Foundation.ServantSpec ()
import ServantApi.ExternalApis.TypeSpec ()
  

instance Arbitrary (Route Auth) where
  arbitrary = oneof
    [ return CheckR
    , return LoginR
    , return LogoutR
    , PluginR <$> arbitrary <*> arbitrary
    ]

instance Arbitrary (Route EmbeddedStatic) where
  arbitrary = do
    let printableText = pack . filter (/= '/') . getPrintableString <$> arbitrary
        printableText' = printableText `suchThat` (not . null)
    pathLength <- getPositive <$> arbitrary
    path <- replicateM pathLength printableText'
    paramNum <- getNonNegative <$> arbitrary
    params <- replicateM paramNum $ (,) <$> printableText' <*> printableText
    return $ embeddedResourceR path params

instance (HasRoute (ServantApiUnproxy' api), HasGenRequest (ServantApiUnproxy' api)) => Arbitrary (Route (ServantApi api)) where
  arbitrary = do
    genReq <- view _2 . genRequest $ Proxy @(ServantApiUnproxy' api)
    let req = genReq $ BaseUrl Http "" 0 ""
        p = filter (not . null) . URI.decodePathSegments $ HTTP.path req
        qs = over (traverse . _2) (fromMaybe mempty) . URI.parseQueryText $ HTTP.queryString req
    maybe (error $ "Could not parse generated servant route: " <> show (p, qs)) return $ parseServantRoute (p, qs)
    
  
instance Arbitrary WellKnownFileName where
  arbitrary = genericArbitrary
  shrink = genericShrink
  
instance Arbitrary SchoolR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary CourseR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary SheetR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary SubmissionR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary MaterialR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary TutorialR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary ExamR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary ExamOfficeR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary EExamR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary CourseNewsR where
  arbitrary = genericArbitrary
  shrink = genericShrink
  
instance Arbitrary CourseEventR where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary (Route UniWorX) where
  arbitrary = genericArbitrary
  shrink = genericShrink

spec :: Spec
spec = do
  parallel $ 
    lawsCheckHspec (Proxy @(Route UniWorX))
      [ eqLaws, hashableLaws, jsonLaws, jsonKeyLaws, pathPieceLaws ]