diff --git a/brittany.cabal b/brittany.cabal index ffd8d42..ee0035b 100644 --- a/brittany.cabal +++ b/brittany.cabal @@ -72,6 +72,7 @@ common library -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-prepositive-qualified-module + -Wno-safe -Wno-unsafe common executable @@ -134,8 +135,6 @@ test-suite unittests build-depends: , hspec ^>= 2.8.3 main-is: TestMain.hs - other-modules: TestUtils - AsymptoticPerfTests hs-source-dirs: src-unittests test-suite littests diff --git a/src-unittests/AsymptoticPerfTests.hs b/src-unittests/AsymptoticPerfTests.hs deleted file mode 100644 index 702ab90..0000000 --- a/src-unittests/AsymptoticPerfTests.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} - -module AsymptoticPerfTests where - - - -import Language.Haskell.Brittany.Internal.PreludeUtils -import qualified Data.Text as Text - -import Test.Hspec - -import TestUtils - - - -asymptoticPerfTest :: Spec -asymptoticPerfTest = do - it "10 do statements" - $ roundTripEqualWithTimeout 1500000 - $ (Text.pack "func = do\n") - <> Text.replicate 10 (Text.pack " statement\n") - it "10 do nestings" - $ roundTripEqualWithTimeout 4000000 - $ (Text.pack "func = ") - <> mconcat - ( [1 .. 10] - <&> \(i :: Int) -> - (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n") - ) - <> Text.replicate 2000 (Text.pack " ") - <> Text.pack "return\n" - <> Text.replicate 2002 (Text.pack " ") - <> Text.pack "()" - it "10 AppOps" - $ roundTripEqualWithTimeout 1000000 - $ (Text.pack "func = expr") - <> Text.replicate 10 (Text.pack "\n . expr") --TODO diff --git a/src-unittests/TestMain.hs b/src-unittests/TestMain.hs index 2f0f894..33af44b 100644 --- a/src-unittests/TestMain.hs +++ b/src-unittests/TestMain.hs @@ -1,6 +1,103 @@ +{-# LANGUAGE ScopedTypeVariables #-} + import Test.Hspec -import AsymptoticPerfTests +import Language.Haskell.Brittany.Internal.Prelude +import qualified Data.Maybe +import qualified Data.Semigroup as Semigroup +import qualified Data.Text as Text + +import Language.Haskell.Brittany.Internal + +import Language.Haskell.Brittany.Internal.Config.Types +import Language.Haskell.Brittany.Internal.Config + +import System.Timeout ( timeout ) + +import Data.Coerce ( coerce ) + + + +import Language.Haskell.Brittany.Internal.PreludeUtils + + + +asymptoticPerfTest :: Spec +asymptoticPerfTest = do + it "10 do statements" + $ roundTripEqualWithTimeout 1500000 + $ (Text.pack "func = do\n") + <> Text.replicate 10 (Text.pack " statement\n") + it "10 do nestings" + $ roundTripEqualWithTimeout 4000000 + $ (Text.pack "func = ") + <> mconcat + ( [1 .. 10] + <&> \(i :: Int) -> + (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n") + ) + <> Text.replicate 2000 (Text.pack " ") + <> Text.pack "return\n" + <> Text.replicate 2002 (Text.pack " ") + <> Text.pack "()" + it "10 AppOps" + $ roundTripEqualWithTimeout 1000000 + $ (Text.pack "func = expr") + <> Text.replicate 10 (Text.pack "\n . expr") --TODO + + + +roundTripEqual :: Text -> Expectation +roundTripEqual t = + fmap (fmap PPTextWrapper) + (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) + `shouldReturn` Right (PPTextWrapper t) + +roundTripEqualWithTimeout :: Int -> Text -> Expectation +roundTripEqualWithTimeout time t = + timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust) + where + action = fmap (fmap PPTextWrapper) + (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) + +newtype PPTextWrapper = PPTextWrapper Text + deriving Eq + +instance Show PPTextWrapper where + show (PPTextWrapper t) = "\n" ++ Text.unpack t + +defaultTestConfig :: Config +defaultTestConfig = Config + { _conf_version = _conf_version staticDefaultConfig + , _conf_debug = _conf_debug staticDefaultConfig + , _conf_layout = LayoutConfig + { _lconfig_cols = coerce (80 :: Int) + , _lconfig_indentPolicy = coerce IndentPolicyFree + , _lconfig_indentAmount = coerce (2 :: Int) + , _lconfig_indentWhereSpecial = coerce True + , _lconfig_indentListSpecial = coerce True + , _lconfig_importColumn = coerce (60 :: Int) + , _lconfig_importAsColumn = coerce (60 :: Int) + , _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3 + , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7) + , _lconfig_alignmentLimit = coerce (30 :: Int) + , _lconfig_alignmentBreakOnMultiline = coerce True + , _lconfig_hangingTypeSignature = coerce False + , _lconfig_reformatModulePreamble = coerce True + , _lconfig_allowSingleLineExportList = coerce True + , _lconfig_allowHangingQuasiQuotes = coerce True + , _lconfig_experimentalSemicolonNewlines = coerce False + -- , _lconfig_allowSinglelineRecord = coerce False + } + , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) + { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever + } + , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig) + , _conf_forward = ForwardOptions {_options_ghc = Identity []} + , _conf_roundtrip_exactprint_only = coerce False + , _conf_disable_formatting = coerce False + , _conf_obfuscate = coerce False + } diff --git a/src-unittests/TestUtils.hs b/src-unittests/TestUtils.hs deleted file mode 100644 index 942f4aa..0000000 --- a/src-unittests/TestUtils.hs +++ /dev/null @@ -1,75 +0,0 @@ -module TestUtils where - - - -import Language.Haskell.Brittany.Internal.Prelude -import qualified Data.Maybe -import qualified Data.Semigroup as Semigroup -import qualified Data.Text as Text - -import Test.Hspec - --- import NeatInterpolation - -import Language.Haskell.Brittany.Internal - -import Language.Haskell.Brittany.Internal.Config.Types -import Language.Haskell.Brittany.Internal.Config - -import System.Timeout ( timeout ) - -import Data.Coerce ( coerce ) - - - -roundTripEqual :: Text -> Expectation -roundTripEqual t = - fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) - `shouldReturn` Right (PPTextWrapper t) - -roundTripEqualWithTimeout :: Int -> Text -> Expectation -roundTripEqualWithTimeout time t = - timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust) - where - action = fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) - -newtype PPTextWrapper = PPTextWrapper Text - deriving Eq - -instance Show PPTextWrapper where - show (PPTextWrapper t) = "\n" ++ Text.unpack t - -defaultTestConfig :: Config -defaultTestConfig = Config - { _conf_version = _conf_version staticDefaultConfig - , _conf_debug = _conf_debug staticDefaultConfig - , _conf_layout = LayoutConfig - { _lconfig_cols = coerce (80 :: Int) - , _lconfig_indentPolicy = coerce IndentPolicyFree - , _lconfig_indentAmount = coerce (2 :: Int) - , _lconfig_indentWhereSpecial = coerce True - , _lconfig_indentListSpecial = coerce True - , _lconfig_importColumn = coerce (60 :: Int) - , _lconfig_importAsColumn = coerce (60 :: Int) - , _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3 - , _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7) - , _lconfig_alignmentLimit = coerce (30 :: Int) - , _lconfig_alignmentBreakOnMultiline = coerce True - , _lconfig_hangingTypeSignature = coerce False - , _lconfig_reformatModulePreamble = coerce True - , _lconfig_allowSingleLineExportList = coerce True - , _lconfig_allowHangingQuasiQuotes = coerce True - , _lconfig_experimentalSemicolonNewlines = coerce False - -- , _lconfig_allowSinglelineRecord = coerce False - } - , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig) - { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever - } - , _conf_preprocessor = (_conf_preprocessor staticDefaultConfig) - , _conf_forward = ForwardOptions {_options_ghc = Identity []} - , _conf_roundtrip_exactprint_only = coerce False - , _conf_disable_formatting = coerce False - , _conf_obfuscate = coerce False - }