Remove origin test to ghcup-test subdir

test/ghcup-test/GHCup/ArbitraryTypes.hs

@@ -0,0 +1,204 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module GHCup.ArbitraryTypes where
+
+
+import           GHCup.Types
+
+import           Data.ByteString                ( ByteString )
+import           Data.Versions
+import           Data.List.NonEmpty
+import           Data.Time.Calendar             ( Day(..) )
+import           Test.QuickCheck
+import           Test.QuickCheck.Arbitrary.ADT  ( ToADTArbitrary )
+import           Test.QuickCheck.Arbitrary.Generic
+import           URI.ByteString
+
+import qualified Data.Map.Strict               as M
+import qualified Data.Text                     as T
+import qualified Data.Text.Encoding            as E
+import qualified Data.Text.Lazy                as T
+                                                ( toStrict )
+import qualified Data.Text.Lazy.Builder        as B
+import qualified Data.Text.Lazy.Builder.Int    as B
+
+
+    -----------------
+    --[ utilities ]--
+    -----------------
+
+intToText :: Integral a => a -> T.Text
+intToText = T.toStrict . B.toLazyText . B.decimal
+
+genVer :: Gen (Int, Int, Int)
+genVer =
+  (\x y z -> (getPositive x, getPositive y, getPositive z))
+    <$> arbitrary
+    <*> arbitrary
+    <*> arbitrary
+
+
+instance ToADTArbitrary GHCupInfo
+
+
+
+    ----------------------
+    --[ base arbitrary ]--
+    ----------------------
+
+instance Arbitrary T.Text where
+  arbitrary = fmap T.pack $ listOf $ elements ['a' .. 'z']
+  shrink xs = T.pack <$> shrink (T.unpack xs)
+
+instance Arbitrary (NonEmpty Word) where
+  arbitrary = fmap fromList $ listOf1 arbitrary
+
+-- utf8 encoded bytestring
+instance Arbitrary ByteString where
+  arbitrary = fmap (E.encodeUtf8 . T.pack) $ listOf $ elements ['a' .. 'z']
+
+
+
+    ---------------------
+    --[ uri arbitrary ]--
+    ---------------------
+
+instance Arbitrary Scheme where
+  arbitrary = elements [ Scheme "http", Scheme "https" ]
+
+instance Arbitrary Host where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Port where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Day where
+  arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
+
+instance Arbitrary (URIRef Absolute) where
+  arbitrary =
+    URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
+
+
+
+    -------------------------
+    --[ version arbitrary ]--
+    -------------------------
+
+instance Arbitrary Mess where
+  arbitrary = do
+    (x, y, z) <- genVer
+    pure
+      $ either (error . show) id
+      $ mess (intToText x <> "." <> intToText y <> "." <> intToText z)
+
+instance Arbitrary Version where
+  arbitrary = do
+    (x, y, z) <- genVer
+    pure
+      $ either (error . show) id
+      $ version (intToText x <> "." <> intToText y <> "." <> intToText z)
+
+instance Arbitrary SemVer where
+  arbitrary = do
+    (x, y, z) <- genVer
+    pure
+      $ either (error . show) id
+      $ semver (intToText x <> "." <> intToText y <> "." <> intToText z)
+
+instance Arbitrary PVP where
+  arbitrary = do
+    (x, y, z) <- genVer
+    pure
+      $ either (error . show) id
+      $ pvp (intToText x <> "." <> intToText y <> "." <> intToText z)
+
+instance Arbitrary Versioning where
+  arbitrary = Ideal <$> arbitrary
+
+
+
+    -----------------------
+    --[ ghcup arbitrary ]--
+    -----------------------
+
+instance Arbitrary Requirements where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary DownloadInfo where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary LinuxDistro where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Platform where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Tag where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Architecture where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary VersionInfo where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary VersionRange where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary (NonEmpty VersionCmp) where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary VersionCmp where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary TarDir where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary Tool where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary GlobalTool where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary GHCupInfo where
+  arbitrary = genericArbitrary
+  shrink    = genericShrink
+
+instance Arbitrary GHCTargetVersion where
+  arbitrary = GHCTargetVersion Nothing <$> arbitrary
+  shrink    = genericShrink
+
+
+-- our maps are nested... the default size easily blows up most ppls ram
+
+instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Tool v) where
+  arbitrary = resize 8 $ M.fromList <$> arbitrary
+
+instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Version) v) where
+  arbitrary = resize 8 $ M.fromList <$> arbitrary
+
+instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map Platform v) where
+  arbitrary = resize 8 $ M.fromList <$> arbitrary
+
+instance {-# OVERLAPS #-} Arbitrary v => Arbitrary (M.Map (Maybe Versioning) v) where
+  arbitrary = resize 8 $ M.fromList <$> arbitrary
+

test/ghcup-test/GHCup/Prelude/File/Posix/TraversalsSpec.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE CPP #-}
+
+module GHCup.Prelude.File.Posix.TraversalsSpec where
+
+
+#if !defined(IS_WINDOWS)
+import           GHCup.Prelude.File.Posix.Traversals
+
+import           Control.Monad.IO.Class (liftIO)
+import           Data.List
+import           System.Posix.Directory
+import           Unsafe.Coerce
+#endif
+
+import           Test.Hspec
+
+
+
+spec :: Spec
+spec = do
+#if defined(IS_WINDOWS)
+  pure ()
+#else
+  -- https://github.com/haskell/ghcup-hs/issues/415
+  describe "GHCup.Prelude.File.Posix.Traversals" $ do
+    it "readDirEnt" $ do
+      dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
+      (dt1, fp1) <- readDirEntPortable dirstream
+      (dt2, fp2) <- readDirEntPortable dirstream
+      (dt3, fp3) <- readDirEntPortable dirstream
+      (dt4, fp4) <- readDirEntPortable dirstream
+      let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
+                          , (dt3, fp3), (dt4, fp4)
+                          ]
+      xs `shouldBe` [(unsafeCoerce (4 :: Int),".")
+                    ,(unsafeCoerce (4 :: Int),"..")
+                    ,(unsafeCoerce (4 :: Int),"dir")
+                    ,(unsafeCoerce (8 :: Int),"file")
+                    ]
+#endif

test/ghcup-test/GHCup/Types/JSONSpec.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE TypeApplications #-}
+
+module GHCup.Types.JSONSpec where
+
+import           GHCup.ArbitraryTypes ()
+import           GHCup.Types hiding ( defaultSettings )
+import           GHCup.Types.JSON ()
+import           GHCup.Prelude
+
+import           Test.Aeson.GenericSpecs
+import           Test.Hspec
+
+
+
+spec :: Spec
+spec = do
+  roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
+ where
+  goldenDir
+    | isWindows = "test/ghcup-test/golden/windows"
+    | otherwise = "test/ghcup-test/golden/unix"
+

test/ghcup-test/GHCup/Utils/FileSpec.hs

@@ -0,0 +1,58 @@
+module GHCup.Utils.FileSpec where
+
+import           GHCup.Prelude.File
+
+import           Data.List
+import           System.Directory
+import           System.FilePath
+import           System.IO.Unsafe
+import qualified Streamly.Prelude              as S
+
+import           Test.Hspec
+
+
+
+spec :: Spec
+spec = do
+  describe "GHCup.Utils.File" $ do
+    it "getDirectoryContentsRecursiveBFS" $ do
+      l1 <- sort <$> S.toList (getDirectoryContentsRecursiveBFSUnsafe "lib")
+      l2 <- sort <$> getDirectoryContentsRecursiveLazy "lib"
+      not (null l1) `shouldBe` True
+      not (null l2) `shouldBe` True
+      l1 `shouldBe` l2
+    it "getDirectoryContentsRecursiveDFS" $ do
+      l1 <- sort <$> S.toList (getDirectoryContentsRecursiveDFSUnsafe "lib")
+      l2 <- sort <$> getDirectoryContentsRecursiveLazy "lib"
+      not (null l1) `shouldBe` True
+      not (null l2) `shouldBe` True
+      l1 `shouldBe` l2
+
+
+getDirectoryContentsRecursiveLazy :: FilePath -> IO [FilePath]
+getDirectoryContentsRecursiveLazy topdir = recurseDirectories [""]
+  where
+    recurseDirectories :: [FilePath] -> IO [FilePath]
+    recurseDirectories []         = return []
+    recurseDirectories (dir:dirs) = unsafeInterleaveIO $ do
+      (files, dirs') <- collect [] [] =<< getDirectoryContents (topdir </> dir)
+      files' <- recurseDirectories (dirs' ++ dirs)
+      return (files ++ files')
+
+      where
+        collect files dirs' []              = return (reverse files
+                                                     ,reverse dirs')
+        collect files dirs' (entry:entries) | ignore entry
+                                            = collect files dirs' entries
+        collect files dirs' (entry:entries) = do
+          let dirEntry = dir </> entry
+          isDirectory <- doesDirectoryExist (topdir </> dirEntry)
+          if isDirectory
+            then collect files (dirEntry:dirs') entries
+            else collect (dirEntry:files) dirs' entries
+
+        ignore ['.']      = True
+        ignore ['.', '.'] = True
+        ignore _          = False
+
+

test/ghcup-test/Main.hs

@@ -0,0 +1,9 @@
+import Test.Hspec.Runner
+import qualified Spec
+
+
+main :: IO ()
+main =
+  hspecWith
+    defaultConfig
+    Spec.spec

test/ghcup-test/Spec.hs

@@ -0,0 +1,2 @@
+-- file test/Spec.hs
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}