content: {-# LANGUAGE FlexibleInstances #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Path.Gen where
  
  import Data.Functor
  import Prelude
  
  import Path
  import Path.Internal
  
  import qualified System.FilePath as FilePath
  
  import Data.GenValidity
  import Data.List (isSuffixOf)
  import Data.Maybe (mapMaybe)
  
  import Test.QuickCheck
  
  instance Validity (Path Abs File) where
    validate p@(Path fp) =
      mconcat
        [ validateCommon p,
          validateAbs p,
          validateFile p,
          declare "The path can be identically parsed as an absolute file path." $
            parseAbsFile fp == Just p
        ]
  
  instance Validity (Path Rel File) where
    validate p@(Path fp) =
      mconcat
        [ validateCommon p,
          validateRel p,
          validateFile p,
          declare "The path can be identically parsed as a relative file path." $
            parseRelFile fp == Just p
        ]
  
  instance Validity (Path Abs Dir) where
    validate p@(Path fp) =
      mconcat
        [ validateCommon p,
          validateAbs p,
          validateDirectory p,
          declare "The path can be identically parsed as an absolute directory path." $
            parseAbsDir fp == Just p
        ]
  
  instance Validity (Path Rel Dir) where
    validate p@(Path fp) =
      mconcat
        [ validateCommon p,
          validateRel p,
          validateDirectory p,
          declare "The path can be identically parsed as a relative directory path if it's not empty." $
            parseRelDir fp == Just p || fp == ""
        ]
  
  instance Validity (SomeBase Dir)
  
  instance Validity (SomeBase File)
  
  validateCommon :: Path b t -> Validation
  validateCommon (Path fp) = mconcat
    [ declare "System.FilePath considers the path valid if it's not empty." $ FilePath.isValid fp || fp == ""
    , declare "The path does not contain a '..' path component." $ not (hasParentDir fp)
    ]
  
  validateDirectory :: Path b Dir -> Validation
  validateDirectory (Path fp) = mconcat
    [ declare "The path has a trailing path separator if it's not empty." $ FilePath.hasTrailingPathSeparator fp || fp == ""
    ]
  
  validateFile :: Path b File -> Validation
  validateFile (Path fp) = mconcat
    [ declare "The path has no trailing path separator." $ not (FilePath.hasTrailingPathSeparator fp)
    , declare "The path does not equal \".\"" $ fp /= "."
    , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)
    ]
  
  validateAbs :: Path Abs t -> Validation
  validateAbs (Path fp) = mconcat
    [ declare "The path is absolute." $ FilePath.isAbsolute fp
    ]
  
  validateRel :: Path Rel t -> Validation
  validateRel (Path fp) = mconcat
    [ declare "The path is relative." $ FilePath.isRelative fp
    ]
  
  instance GenValid (Path Abs File) where
    genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid
    shrinkValid = filter isValid . shrinkValidWith parseAbsFile
  
  instance GenValid (Path Abs Dir) where
    genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid
    shrinkValid = filter isValid . shrinkValidWith parseAbsDir
  
  instance GenValid (Path Rel File) where
    genValid = (Path <$> genFilePath) `suchThat` isValid
    shrinkValid = filter isValid . shrinkValidWith parseRelFile
  
  instance GenValid (Path Rel Dir) where
    genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid
    shrinkValid = filter isValid . shrinkValidWith parseRelDir
  
  instance GenValid (SomeBase Dir) where
    genValid = genValidStructurallyWithoutExtraChecking
    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
  
  instance GenValid (SomeBase File) where
    genValid = genValidStructurallyWithoutExtraChecking
    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
  
  -- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and
  -- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to
  -- be valid.
  genFilePath :: Gen FilePath
  genFilePath = listOf genPathyChar
  
  genPathyChar :: Gen Char
  genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")]
  
  shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]
  shrinkValidWith fun (Path f) = filter (/= Path f) . mapMaybe fun $ shrinkValid f
  