{-# OPTIONS -Wno-orphans #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as LB
import qualified Data.ByteString.Lazy as LB
import Data.Char ( chr, isSpace )
import Data.Foldable ( foldMap )
import qualified Data.HashMap.Strict as HM
import Data.List ( sort )
import Data.Semigroup
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Word
import Control.Monad.IO.Class ( liftIO )
import System.Random.Shuffle
import "hspec" Test.Hspec
import "hspec" Test.Hspec.QuickCheck
import "QuickCheck" Test.QuickCheck
import "quickcheck-instances" Test.QuickCheck.Instances.ByteString ()
import "QuickCheck" Test.QuickCheck.Monadic
import "quickcheck-unicode" Test.QuickCheck.Unicode
import Data.String.Interpolate ( i, iii )
import Data.String.Interpolate.Conversion hiding
( build, finalize, interpolate, ofString, chompSpaces )
main :: IO ()
main = hspec $ parallel $ do
describe "i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do
it "should allow an escaped backslash right before an interp" $ do
let var :: String = "bar"
expected :: String = "foo\\bar"
[i|foo\\#{var}|] `shouldBe` expected
it "should only escape verbatim segments a single time" $ do
let expected :: String = "\\\\\\\\"
[i|\\\\\\\\|] `shouldBe` expected
it "should parse TypeApplications" $ do
let expected :: String = "2"
[i|#{show @Int 2}|] `shouldBe` expected
context "when using String as a parameter" $ do
prop "just interpolating should be id" $
\(UTF8S str) -> [i|#{str}|] == str
prop "should passthrough a conversion to strict Text and back unchanged" $
\(UTF8S str) -> iID @String @T.Text str
prop "should passthrough a conversion to lazy Text and back unchanged" $
\(UTF8S str) -> iID @String @LT.Text str
prop "should passthrough a conversion to strict ByteString and back unchanged" $
\(UTF8S str) -> iID @String @B.ByteString str
prop "should passthrough a conversion to lazy ByteString and back unchanged" $
\(UTF8S str) -> iID @String @LB.ByteString str
context "when using strict Text as a parameter" $ do
prop "just interpolating should be id" $
\(t :: T.Text) -> [i|#{t}|] == t
prop "should passthrough a conversion to String and back unchanged" $ iID @T.Text @String
prop "should passthrough a conversion to lazy Text and back unchanged" $ iID @T.Text @LT.Text
prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @T.Text @B.ByteString
prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @T.Text @LB.ByteString
context "when using lazy Text as a parameter" $ do
prop "just interpolating should be id" $
\(lt :: LT.Text) -> [i|#{lt}|] == lt
prop "should passthrough a conversion to String and back unchanged" $ iID @LT.Text @String
prop "should passthrough a conversion to strict Text and back unchanged" $ iID @LT.Text @T.Text
prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @LT.Text @B.ByteString
prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @LT.Text @LB.ByteString
context "when using strict ByteString as a parameter" $ do
prop "just interpolating should be id" $
\(b :: B.ByteString) -> [i|#{b}|] == b
prop "should passthrough a conversion to lazy ByteString and back unchanged" $ iID @B.ByteString @LB.ByteString
context "and the ByteString is valid UTF8" $ do
prop "should passthrough a conversion to String and back unchanged" $ do
\(UTF8BS b) -> iID @B.ByteString @String b
prop "should passthrough a conversion to strict Text and back unchanged" $ do
\(UTF8BS b) -> iID @B.ByteString @T.Text b
prop "should passthrough a conversion to lazy Text and back unchanged" $ do
\(UTF8BS b) -> iID @B.ByteString @LT.Text b
context "when using lazy ByteString as a parameter" $ do
prop "just interpolating should be id" $
\(lb :: LB.ByteString) -> [i|#{lb}|] == lb
prop "should passthrough a conversion to strict ByteString and back unchanged" $ iID @LB.ByteString @B.ByteString
context "and the ByteString is valid UTF8" $ do
prop "should passthrough a conversion to String and back unchanged" $
\(UTF8LBS lb) -> iID @LB.ByteString @String lb
prop "should passthrough a conversion to strict Text and back unchanged" $
\(UTF8LBS lb) -> iID @LB.ByteString @T.Text lb
prop "should passthrough a conversion to lazy Text and back unchanged" $
\(UTF8LBS lb) -> iID @LB.ByteString @LT.Text lb
context "when using Char as a parameter" $ do
prop "interpolating into a String shouldn't have quotes" $
\(UTF8C c) -> [i|#{c}|] == [c]
prop "interpolating into strict Text shouldn't have quotes" $
\(UTF8C c) -> [i|#{c}|] == T.singleton c
prop "interpolating into lazy Text shouldn't have quotes" $
\(UTF8C c) -> [i|#{c}|] == LT.singleton c
prop "interpolating into strict ByteString shouldn't have quotes" $
\(UTF8C c) -> [i|#{c}|] == (LB.toStrict $ LB.toLazyByteString $ LB.charUtf8 c)
prop "interpolating into lazy ByteString shouldn't have quotes" $
\(UTF8C c) -> [i|#{c}|] == (LB.toLazyByteString $ LB.charUtf8 c)
context "when interpolating into strict ByteString" $ do
it "should handle literal Unicode strings correctly" $ do
let interpolated :: B.ByteString = [i|λ|]
expected :: B.ByteString = "\xCE\xBB"
interpolated `shouldBe` expected
context "when interpolating into lazy ByteString" $ do
it "should handle literal Unicode strings correctly" $ do
let interpolated :: LB.ByteString = [i|λ|]
expected :: LB.ByteString = "\xCE\xBB"
interpolated `shouldBe` expected
-- describe "__i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do
-- context "when there are no newlines" $ do
-- prop "is the same as i" $
-- \(NonwhitespaceText t) ->
-- let iResult :: T.Text = [i|#{t}|]
-- __iResult :: T.Text = [__i|#{t}|]
-- in iResult == __iResult
-- context "when there are newlines" $ do
-- it "handles a small code snippet correctly" $ do
-- let interpolated :: T.Text =
-- [__i|
-- id :: a -> a
-- id x = y
-- where y = x
-- |]
-- expected :: T.Text = "id :: a -> a\nid x = y\n where y = x"
-- interpolated `shouldBe` expected
-- prop "produces the same output for different indentation levels" $
-- \(lines :: [(Word8, T.Text)]) (indent :: Word8) ->
-- let unindented = flip fmap (unshift lines) $ \(level, line) ->
-- leftPad (fromIntegral level) ' ' line
-- indented = (leftPad (fromIntegral indent) ' ') <$> unindented
-- unindentedResult :: T.Text = [__i|#{T.unlines unindented}|]
-- indentedResult :: T.Text = [__i|#{T.unlines indented}|]
-- in unindentedResult == indentedResult
-- context "is idempotent" $ do
-- prop "into String" $ __iIdempotent @String
-- prop "into strict Text" $ __iIdempotent @T.Text
-- prop "into lazy Text" $ __iIdempotent @LT.Text
-- prop "into strict ByteString" $ __iIdempotent @B.ByteString
-- prop "into lazy ByteString" $ __iIdempotent @LB.ByteString
-- context "is idempotently its own inverse" $ do
-- context "from String" $ do
-- prop "into strict Text" $ __iIdempotentInverse @String @T.Text
-- prop "into lazy Text" $ __iIdempotentInverse @String @LT.Text
-- prop "into strict ByteString" $ __iIdempotentInverse @String @B.ByteString
-- prop "into lazy ByteString" $ __iIdempotentInverse @String @LB.ByteString
-- context "from strict Text" $ do
-- prop "into String" $ __iIdempotentInverse @T.Text @String
-- prop "into lazy Text" $ __iIdempotentInverse @T.Text @LT.Text
-- prop "into strict ByteString" $ __iIdempotentInverse @T.Text @B.ByteString
-- prop "into lazy ByteString" $ __iIdempotentInverse @T.Text @LB.ByteString
-- context "from lazy Text" $ do
-- prop "into String" $ __iIdempotentInverse @LT.Text @String
-- prop "into strict Text" $ __iIdempotentInverse @LT.Text @T.Text
-- prop "into strict ByteString" $ __iIdempotentInverse @LT.Text @B.ByteString
-- prop "into lazy ByteString" $ __iIdempotentInverse @LT.Text @LB.ByteString
-- context "from strict ByteString" $ do
-- prop "into String" $ __iIdempotentInverse @B.ByteString @String
-- prop "into strict Text" $ __iIdempotentInverse @B.ByteString @T.Text
-- prop "into lazy Text" $ __iIdempotentInverse @B.ByteString @LT.Text
-- prop "into lazy ByteString" $ __iIdempotentInverse @B.ByteString @LB.ByteString
-- context "from lazy ByteString" $ do
-- prop "into String" $ __iIdempotentInverse @LB.ByteString @String
-- prop "into strict Text" $ __iIdempotentInverse @LB.ByteString @T.Text
-- prop "into lazy Text" $ __iIdempotentInverse @LB.ByteString @LT.Text
-- prop "into strict ByteString" $ __iIdempotentInverse @LB.ByteString @B.ByteString
-- -- I'm not sure whether these laws actually hold, because of tabs. Will
-- -- have to look at this more closely.
-- prop "is commutative with reversing lines" $
-- \(SpaceyText t) ->
-- [__i|#{T.unlines (reverse (T.lines t))}|] == T.unlines (reverse (T.lines [__i|#{t}|]))
-- prop "is commutative with sorting lines" $
-- \(SpaceyText t) ->
-- [__i|#{T.unlines (sort (T.lines t))}|] == T.unlines (sort (T.lines [__i|#{t}|]))
-- prop "removes same indentation when lines rearranged" $
-- \(SpaceyText t) ->
-- monadicIO $ do
-- shuffled <- T.unlines <$> liftIO (shuffleM $ T.lines t)
-- assert $ sort (T.lines [__i|#{shuffled}|]) == sort (T.lines [__i|#{t}|])
-- prop "non-whitespace chars in output same as in input" $
-- \(SpaceyText t) -> charFrequencies [__i|#{t}|] == charFrequencies t
-- prop "output string length <= input string length" $
-- \(SpaceyText t) -> T.length [__i|#{t}|] <= T.length t
-- prop "output words = input words" $
-- \(SpaceyText t) -> T.words t == T.words [__i|#{t}|]
describe "iii" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do
context "when there isn't any whitespace" $ do
prop "is the same as i" $
\(NonwhitespaceText t) ->
let iResult :: T.Text = [i|#{t}|]
iiiResult :: T.Text = [iii|#{t}|]
in iResult == iiiResult
context "when there is whitespace" $ do
it "collapses a small example of whitespace" $ do
let interpolated :: T.Text = [iii| foo bar baz |]
expected :: T.Text = "foo bar baz"
interpolated `shouldBe` expected
it "collapses a small example of newlines" $ do
let interpolated :: T.Text =
[iii|
Lorem ipsum dolor sit amet,
consectetur adipiscing elit.
Aenean congue iaculis dui,
at iaculis sapien interdum nec.
|]
expected :: T.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Aenean congue iaculis dui, at iaculis sapien interdum nec."
interpolated `shouldBe` expected
prop "never has any newlines" $
\(SpaceyText t) -> T.all (/= '\n') [iii|#{t}|]
prop "never has more than one consecutive space" $
\(SpaceyText t) ->
let chunks = T.groupBy (\c1 c2 -> isSpace c1 == isSpace c2) [iii|#{t}|]
in all (\chunk -> T.all (not . isSpace) chunk || T.length chunk <= 1) chunks
prop "never has leading whitespace" $
\(SpaceyText t) -> T.null $ T.takeWhile isSpace [iii|#{t}|]
prop "never has trailing whitespace" $
\(SpaceyText t) -> T.null $ T.takeWhileEnd isSpace [iii|#{t}|]
context "is idempotent" $ do
prop "into String" $ iiiIdempotent @String
prop "into strict Text" $ iiiIdempotent @T.Text
prop "into lazy Text" $ iiiIdempotent @LT.Text
prop "into strict ByteString" $ iiiIdempotent @B.ByteString
prop "into lazy ByteString" $ iiiIdempotent @LB.ByteString
context "is idempotently its own inverse" $ do
context "from String" $ do
prop "into strict Text" $ iiiIdempotentInverse @String @T.Text
prop "into lazy Text" $ iiiIdempotentInverse @String @LT.Text
prop "into strict ByteString" $ iiiIdempotentInverse @String @B.ByteString
prop "into lazy ByteString" $ iiiIdempotentInverse @String @LB.ByteString
context "from strict Text" $ do
prop "into String" $ iiiIdempotentInverse @T.Text @String
prop "into lazy Text" $ iiiIdempotentInverse @T.Text @LT.Text
prop "into strict ByteString" $ iiiIdempotentInverse @T.Text @B.ByteString
prop "into lazy ByteString" $ iiiIdempotentInverse @T.Text @LB.ByteString
context "from lazy Text" $ do
prop "into String" $ iiiIdempotentInverse @LT.Text @String
prop "into strict Text" $ iiiIdempotentInverse @LT.Text @T.Text
prop "into strict ByteString" $ iiiIdempotentInverse @LT.Text @B.ByteString
prop "into lazy ByteString" $ iiiIdempotentInverse @LT.Text @LB.ByteString
context "from strict ByteString" $ do
prop "into String" $ iiiIdempotentInverse @B.ByteString @String
prop "into strict Text" $ iiiIdempotentInverse @B.ByteString @T.Text
prop "into lazy Text" $ iiiIdempotentInverse @B.ByteString @LT.Text
prop "into lazy ByteString" $ iiiIdempotentInverse @B.ByteString @LB.ByteString
context "from lazy ByteString" $ do
prop "into String" $ iiiIdempotentInverse @LB.ByteString @String
prop "into strict Text" $ iiiIdempotentInverse @LB.ByteString @T.Text
prop "into lazy Text" $ iiiIdempotentInverse @LB.ByteString @LT.Text
prop "into strict ByteString" $ iiiIdempotentInverse @LB.ByteString @B.ByteString
prop "is commutative with string reversal" $
\(SpaceyText t) -> [iii|#{T.reverse t}|] == T.reverse [iii|#{t}|]
prop "non-whitespace chars in output same as in input" $
\(SpaceyText t) -> charFrequencies [iii|#{t}|] == charFrequencies t
prop "output string length <= input string length" $
\(SpaceyText t) -> T.length [iii|#{t}|] <= T.length t
prop "output words = input words" $
\(SpaceyText t) -> T.words t == T.words [iii|#{t}|]
iID :: forall from to fromflag toflag.
( Eq from
, Interpolatable fromflag to from
, Interpolatable toflag from to
)
=> from
-> Bool
iID from =
let to :: to = [i|#{from}|]
from' :: from = [i|#{to}|]
in from == from'
-- __iIdempotent :: forall to toflag.
-- ( Eq to
-- , Interpolatable toflag to to
-- , Interpolatable toflag T.Text to
-- )
-- => SpaceyText
-- -> Bool
-- __iIdempotent (SpaceyText t) =
-- let x :: to = [__i|#{t}|]
-- x' :: to = [__i|#{x}|]
-- in x == x'
iiiIdempotent :: forall to toflag.
( Eq to
, Interpolatable toflag to to
, Interpolatable toflag T.Text to
, SpaceChompable to
)
=> SpaceyText
-> Bool
iiiIdempotent (SpaceyText t) =
let x :: to = [iii|#{t}|]
x' :: to = [iii|#{x}|]
in x == x'
-- __iIdempotentInverse :: forall from to fromflag toflag.
-- ( Eq from
-- , Interpolatable fromflag T.Text from
-- , Interpolatable toflag from to
-- , Interpolatable fromflag to from
-- )
-- => SpaceyText
-- -> Bool
-- __iIdempotentInverse (SpaceyText t) =
-- let x :: from = [__i|#{t}|]
-- x' :: to = [__i|#{x}|]
-- x'' :: from = [__i|#{x'}|]
-- in x == x''
iiiIdempotentInverse :: forall from to fromflag toflag.
( Eq from
, Interpolatable fromflag T.Text from
, Interpolatable toflag from to
, Interpolatable fromflag to from
, SpaceChompable from
, SpaceChompable to
)
=> SpaceyText
-> Bool
iiiIdempotentInverse (SpaceyText t) =
let x :: from = [iii|#{t}|]
x' :: to = [iii|#{x}|]
x'' :: from = [iii|#{x'}|]
in x == x''
-- -- |
-- -- Reduce each index by the minimum index in the array.
-- unshift :: (Ord a, Num a) => [(a, b)] -> [(a, b)]
-- unshift [] = []
-- unshift l@((x, _) : xs) =
-- let min = getMin $ foldr (\(x, _) m -> Min x <> m) (Min x) xs
-- in (\(x, y) -> (x - min, y)) <$> l
-- -- |
-- -- Add the given number of the specific characters to the left.
-- leftPad :: Int -> Char -> T.Text -> T.Text
-- leftPad amt c t = T.replicate amt (T.singleton c) <> t
-- |
-- The default Arbitrary for Char generates U+FFFF and U+FFFE, which aren't
-- valid Unicode. Sigh...
newtype UTF8Char = UTF8C { unUTF8C :: Char }
deriving newtype (Eq, Show)
newtype UTF8String = UTF8S { unUTF8S :: String }
deriving newtype (Eq, Show)
newtype UTF8ByteString = UTF8BS B.ByteString
deriving newtype (Eq, Show)
newtype UTF8LazyByteString = UTF8LBS LB.ByteString
deriving newtype (Eq, Show)
newtype SpaceyText = SpaceyText T.Text
deriving newtype (Eq, Show)
newtype NonwhitespaceText = NonwhitespaceText T.Text
deriving newtype (Eq, Show)
instance Arbitrary UTF8Char where
arbitrary = UTF8C <$> unicodeChar
shrink (UTF8C c) = UTF8C <$> shrinkChar c
instance Arbitrary UTF8String where
arbitrary = do
chars <- listOf arbitrary
pure $ UTF8S (unUTF8C <$> chars)
shrink (UTF8S str) = case str of
[] -> []
(_:[]) -> []
_ -> let mid = length str `div` 2
in [UTF8S $ take mid str, UTF8S $ drop mid str]
instance Arbitrary T.Text where
arbitrary = T.pack . unUTF8S <$> arbitrary
shrink t = if T.null t || T.length t == 1
then []
else let mid = T.length t `div` 2
in [T.take mid t, T.drop mid t]
instance Arbitrary LT.Text where
arbitrary = LT.pack . unUTF8S <$> arbitrary
shrink lt = if LT.null lt || LT.length lt == 1
then []
else let mid = LT.length lt `div` 2
in [LT.take mid lt, LT.drop mid lt]
instance Arbitrary UTF8ByteString where
arbitrary = UTF8BS . LB.toStrict . LB.toLazyByteString . foldMap LB.charUtf8 . unUTF8S
<$> arbitrary
instance Arbitrary UTF8LazyByteString where
arbitrary = UTF8LBS . LB.toLazyByteString . foldMap LB.charUtf8 . unUTF8S
<$> arbitrary
-- Basically, we want this to be an 'alternation' of sequences of printable
-- characters and whitespace characters.
instance Arbitrary SpaceyText where
arbitrary = SpaceyText . foldMap id
<$> scale
(round . sqrt @Double . fromIntegral)
(listOf (oneof [whitespace, nonwhitespace]))
instance Arbitrary NonwhitespaceText where
arbitrary = NonwhitespaceText <$> nonwhitespace
charFrequencies :: T.Text -> HM.HashMap Char Int
charFrequencies = T.foldl' (flip $ HM.alter increment) HM.empty . T.filter (not . isSpace)
where increment :: Maybe Int -> Maybe Int
increment Nothing = Just 1
increment (Just x) = Just (x + 1)
whitespace :: Gen T.Text
whitespace = T.pack
<$> listOf1 (elements [' ', '\r', '\t', '\n', '\x1680', '\x2000', '\x2006'])
nonwhitespace :: Gen T.Text
nonwhitespace = T.pack
<$> listOf1 nonwhitespaceChar
nonwhitespaceChar :: Gen Char
nonwhitespaceChar = unicodeChar `suchThat` (not . isSpace)
unicodeChar :: Gen Char
unicodeChar = chr `fmap` points
where points = flip suchThat (not . reserved) $ oneof
[ ascii
, plane0
, plane1
, plane2
, plane14
]