{-# LANGUAGE UndecidableInstances #-}

module Model.Types.FileSpec where

import TestImport
import TestInstances ()

import Data.Conduit
import qualified Data.Conduit.Combinators as C

import Data.Ratio ((%))

import System.FilePath
import Data.Time

import qualified Data.Map as Map


scaleRatio :: Rational -> Int -> Int
scaleRatio r = ceiling . (* r) . fromIntegral

instance (LazySequence lazy strict, Arbitrary lazy, Monad m) => Arbitrary (ConduitT () strict m ()) where
  arbitrary = C.sourceLazy <$> arbitrary

instance Monad m => Arbitrary (File m) where
  arbitrary = do
    fileTitle <- scale (scaleRatio $ 1 % 8) $ (joinPath <$> arbitrary) `suchThat` (any $ not . isPathSeparator)
    date <- addDays <$> arbitrary <*> pure (fromGregorian 2043 7 2)
    fileModified <- (addUTCTime <$> arbitrary <*> pure (UTCTime date 0)) `suchThat` inZipRange
    fileContent <- oneof
      [ pure Nothing
      , Just <$> scale (scaleRatio $ 7 % 8) arbitrary
      ]
    return File{..}
    where
      inZipRange :: UTCTime -> Bool
      inZipRange time
        | time > UTCTime (fromGregorian 1980 1 1) 0
        , time < UTCTime (fromGregorian 2107 1 1) 0
        = True
        | otherwise
        = False

instance Arbitrary FileReference where
  arbitrary = pureFileToFileReference <$> arbitrary

instance Arbitrary a => Arbitrary (FileFieldUserOption a) where
  arbitrary = genericArbitrary
  shrink = genericShrink

instance Arbitrary add => Arbitrary (FileReferenceTitleMap FileReference add) where
  arbitrary = do
    fRefs <- arbitrary
    fmap (review _FileReferenceFileReferenceTitleMap . Map.fromList) . for fRefs $ \FileReference{..} -> (fileReferenceTitle, ) . (fileReferenceContent, fileReferenceModified, ) <$> arbitrary

instance Arbitrary (FileReferenceTitleMap fileid (FileFieldUserOption Bool)) => Arbitrary (FileField fileid) where
  arbitrary = genericArbitrary
  shrink = genericShrink

spec :: Spec
spec = do
  parallel $ do
    lawsCheckHspec (Proxy @PureFile)
      [ eqLaws, ordLaws, showLaws ]
    lawsCheckHspec (Proxy @FileReference)
      [ eqLaws, ordLaws, hashableLaws, binaryLaws, jsonLaws ]
    lawsCheckHspec (Proxy @(FileFieldUserOption Bool))
      [ eqLaws, ordLaws, showLaws, showReadLaws, jsonLaws ]
    lawsCheckHspec (Proxy @(FileReferenceTitleMap FileReference (FileFieldUserOption Bool)))
      [ eqLaws, ordLaws, semigroupLaws, monoidLaws, semigroupMonoidLaws, idempotentSemigroupLaws ]
    lawsCheckHspec (Proxy @(FileField FileReference))
      [ eqLaws, ordLaws, jsonLaws ]
