1{-# LANGUAGE UndecidableInstances #-}
2module Main (main) where
3
4import Data.TreeDiff
5import Data.TreeDiff.Golden       (ediffGolden)
6import System.FilePath            ((-<.>), (</>))
7import Test.Tasty                 (TestName, TestTree, defaultMain, testGroup)
8import Test.Tasty.Golden.Advanced (goldenTest)
9import Text.PrettyPrint           (Doc, render)
10
11import qualified Data.ByteString as BS
12import qualified Data.Map.Strict as Map
13
14import Distribution.Fields           (PrettyField (..))
15import Distribution.Types.SourceRepo (KnownRepoType, RepoKind, RepoType, SourceRepo)
16
17import Cabal.Optimization
18import Cabal.Parse
19import Cabal.Project
20import Cabal.SourceRepo
21
22main :: IO ()
23main = defaultMain $ testGroup "golden"
24    [ golden "haskell-ci"
25    ]
26  where
27    golden name = ediffGolden goldenTest name  goldenPath $ do
28        contents <- BS.readFile projectPath
29        either (fail . renderParseError) return $ parseProject projectPath contents
30      where
31        goldenPath = "fixtures" </> name -<.> "golden"
32        projectPath = "fixtures" </> name -<.> "project"
33
34-------------------------------------------------------------------------------
35-- orphans
36-------------------------------------------------------------------------------
37
38instance (ToExpr uri, ToExpr opt, ToExpr pkg) => ToExpr (Project uri opt pkg) where
39    toExpr prj = Rec "Project" $ Map.fromList
40        [ field "prjPackages"     prjPackages
41        , field "prjOptPackages"  prjOptPackages
42        , field "prjUriPackages"  prjUriPackages
43        , field "prjConstraints"  prjConstraints
44        , field "prjAllowNewer"   prjAllowNewer
45        , field "prjReorderGoals" prjReorderGoals
46        , field "prjMaxBackjumps" prjMaxBackjumps
47        , field "prjOptimization" prjOptimization
48        , field "prjSourceRepos"  prjSourceRepos
49        , field "prjOtherFields"  prjOtherFields
50        ]
51      where
52        field name f = (name, toExpr (f prj))
53
54instance ToExpr Optimization
55
56instance ToExpr SourceRepo
57instance ToExpr RepoKind
58instance ToExpr RepoType
59instance ToExpr KnownRepoType
60instance ToExpr (f FilePath) => ToExpr (SourceRepositoryPackage f)
61
62instance ToExpr Doc where
63  toExpr = toExpr . render
64
65instance ToExpr (PrettyField ann) where
66  toExpr (PrettyField _ fn d)       = App "PrettyField"   [toExpr fn, toExpr d]
67  toExpr (PrettySection _ fn ds ps) = App "PrettySection" [toExpr fn, toExpr ds, toExpr ps]
68