ModuleMungingSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.ModuleMungingSpec
  ( spec
  ) where

import Data.Kind (Type)
import Data.String.Interpolate (__i)
import GHC.Stack (HasCallStack)
import ModuleMunging
import Prelude
import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe)

spec :: Spec
spec = parallel do
  describe "Example" do
    it "empty module fragment" do
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo"
            , moduleExports = []
            , moduleImports = []
            , moduleDeclarations = []
            }
        , expectedDisplay = [__i|
            -- Auto-generated - do not manually modify!
            {-\# LANGUAGE ImportQualifiedPost \#-}
            module Foo
              ( \n  ) where\n
          |]
        , testModuleName = ModuleNameExact "Foo"
        , testModuleFragment = mempty
        }

    it "simple" do
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo.Bar"
            , moduleExports = ["foo"]
            , moduleImports =
                [ ModuleImport "Custom.Prelude" ModuleImportStyleOpen
                , ModuleImport "Foo.Baz" $ ModuleImportStyleExplicit ["baz"]
                , ModuleImport "Qualified.Module.A" $ ModuleImportStyleQualified $ Just "A"
                , ModuleImport "Qualified.Module.B" $ ModuleImportStyleQualified $ Just "Module.B"
                ]
            , moduleDeclarations =
                [ ModuleDeclaration True "foo" $ DeclBody [__i|
                    bar :: Int -> Int
                    bar = quux
                  |]
                , ModuleDeclaration False "quux" $ DeclBody [__i|
                    quux :: Int -> Int
                    quux = Module.B.quux . A.quux
                  |]
                ]
            }
        , expectedDisplay = [__i|
              -- Auto-generated - do not manually modify!
              {-\# LANGUAGE ImportQualifiedPost \#-}
              module Foo.Bar
                ( foo
                ) where

              import Custom.Prelude

              import Foo.Baz (baz)

              import Qualified.Module.A qualified as A
              import Qualified.Module.B qualified as Module.B

              bar :: Int -> Int
              bar = quux

              quux :: Int -> Int
              quux = Module.B.quux . A.quux\n
            |]
        , testModuleName = ModuleNameExact "Foo.Bar"
        , testModuleFragment = ModuleFragment
            { moduleFragmentImports =
                [ ModuleImport "Qualified.Module.B" $ ModuleImportStyleQualified $ Just "Module.B"
                , ModuleImport "Custom.Prelude" ModuleImportStyleOpen
                , ModuleImport "Foo.Baz" $ ModuleImportStyleExplicit ["baz"]
                , ModuleImport "Qualified.Module.A" $ ModuleImportStyleQualified $ Just "A"
                ]
            , moduleFragmentDeclarations =
                [ ModuleDeclaration True "foo" $ DeclBody [__i|
                    bar :: Int -> Int
                    bar = quux
                  |]
                , ModuleDeclaration False "quux" $ DeclBody [__i|
                    quux :: Int -> Int
                    quux = Module.B.quux . A.quux
                  |]
                ]
            }
        }

    it "two fragments" do
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo.Bar"
            , moduleExports = ["foo"]
            , moduleImports =
                [ ModuleImport "Custom.Prelude" ModuleImportStyleOpen
                , ModuleImport "Foo.Baz" $ ModuleImportStyleExplicit ["baz"]
                , ModuleImport "Qualified.Module.A" $ ModuleImportStyleQualified $ Just "A"
                , ModuleImport "Qualified.Module.B" $ ModuleImportStyleQualified $ Just "Module.B"
                , ModuleImport "Qualified.Module.C" $ ModuleImportStyleQualified Nothing
                ]
            , moduleDeclarations =
                [ ModuleDeclaration True "foo" $ DeclBody [__i|
                    bar :: Int -> Int
                    bar = quux
                  |]
                , ModuleDeclaration False "quux" $ DeclBody [__i|
                    quux :: Int -> Int
                    quux = Qualified.Module.C.quux . Module.B.quux . A.quux
                  |]
                ]
            }
        , expectedDisplay = [__i|
              -- Auto-generated - do not manually modify!
              {-\# LANGUAGE ImportQualifiedPost \#-}
              module Foo.Bar
                ( foo
                ) where

              import Custom.Prelude

              import Foo.Baz (baz)

              import Qualified.Module.A qualified as A
              import Qualified.Module.B qualified as Module.B
              import Qualified.Module.C qualified

              bar :: Int -> Int
              bar = quux

              quux :: Int -> Int
              quux = Qualified.Module.C.quux . Module.B.quux . A.quux\n
            |]
        , testModuleName = ModuleNameExact "Foo.Bar"
        , testModuleFragment = mconcat
            [ ModuleFragment
                { moduleFragmentImports =
                    [ ModuleImport "Qualified.Module.B" $ ModuleImportStyleQualified $ Just "Module.B"
                    , ModuleImport "Custom.Prelude" ModuleImportStyleOpen
                    , ModuleImport "Foo.Baz" $ ModuleImportStyleExplicit ["baz"]
                    , ModuleImport "Qualified.Module.A" $ ModuleImportStyleQualified $ Just "A"
                    ]
                , moduleFragmentDeclarations =
                    [ ModuleDeclaration True "foo" $ DeclBody [__i|
                        bar :: Int -> Int
                        bar = quux
                      |]
                    ]
                }
            , ModuleFragment
                { moduleFragmentImports =
                    [ ModuleImport "Qualified.Module.C" $ ModuleImportStyleQualified Nothing
                    , ModuleImport "Custom.Prelude" ModuleImportStyleOpen
                    ]
                , moduleFragmentDeclarations =
                    [ ModuleDeclaration False "quux" $ DeclBody [__i|
                        quux :: Int -> Int
                        quux = Qualified.Module.C.quux . Module.B.quux . A.quux
                      |]
                    ]
                }
            ]
        }

    it "module name from filepath" do
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo"
            , moduleExports = []
            , moduleImports = []
            , moduleDeclarations = []
            }
        , expectedDisplay = [__i|
            -- Auto-generated - do not manually modify!
            {-\# LANGUAGE ImportQualifiedPost \#-}
            module Foo
              ( \n  ) where\n
          |]
        , testModuleName = ModuleNameFromFilePath "Foo.hs"
        , testModuleFragment = mempty
        }
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo.Bar"
            , moduleExports = []
            , moduleImports = []
            , moduleDeclarations = []
            }
        , expectedDisplay = [__i|
            -- Auto-generated - do not manually modify!
            {-\# LANGUAGE ImportQualifiedPost \#-}
            module Foo.Bar
              ( \n  ) where\n
          |]
        , testModuleName = ModuleNameFromFilePath "Foo/Bar.hs"
        , testModuleFragment = mempty
        }
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo.Bar"
            , moduleExports = []
            , moduleImports = []
            , moduleDeclarations = []
            }
        , expectedDisplay = [__i|
            -- Auto-generated - do not manually modify!
            {-\# LANGUAGE ImportQualifiedPost \#-}
            module Foo.Bar
              ( \n  ) where\n
          |]
        , testModuleName = ModuleNameFromFilePath "library/Foo/Bar.hs"
        , testModuleFragment = mempty
        }
      runTest TestCase
        { expectedModule = Module
            { moduleName = "Foo.Bar"
            , moduleExports = []
            , moduleImports = []
            , moduleDeclarations = []
            }
        , expectedDisplay = [__i|
            -- Auto-generated - do not manually modify!
            {-\# LANGUAGE ImportQualifiedPost \#-}
            module Foo.Bar
              ( \n  ) where\n
          |]
        , testModuleName = ModuleNameFromFilePath "library\\Foo\\Bar.hs"
        , testModuleFragment = mempty
        }

type TestCase :: Type
data TestCase = TestCase
  { expectedModule :: Module
  , expectedDisplay :: String
  , testModuleName :: ModuleName
  , testModuleFragment :: ModuleFragment
  }

runTest :: HasCallStack => TestCase -> Expectation
runTest testCase = do
  actualModule `shouldBe` expectedModule
  displayModule actualModule `shouldBe` expectedDisplay
  where
  actualModule = buildModule testModuleName testModuleFragment
  TestCase
    { expectedModule
    , expectedDisplay
    , testModuleName
    , testModuleFragment
    } = testCase