{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}

import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Builder as LB
import Data.Foldable ( foldMap )

import "hspec" Test.Hspec
import "hspec" Test.Hspec.QuickCheck
import "QuickCheck" Test.QuickCheck
import "quickcheck-instances" Test.QuickCheck.Instances.ByteString

import "string-interpolate" Data.String.Interpolate ( i )

main :: IO ()
main = hspec $ parallel $ do
  describe "i" $ modifyMaxSuccess (const 10000) $ modifyMaxSize (const 500) $ do
    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) ->
          let t = [i|#{str}|] :: T.Text
              str' = [i|#{t}|] :: String
          in str' == str

      prop "should passthrough a conversion to lazy Text and back unchanged" $
        \(UTF8S str) ->
          let lt = [i|#{str}|] :: LT.Text
              str' = [i|#{lt}|] :: String
          in str' == str

      prop "should passthrough a conversion to strict ByteString and back unchanged" $
        \(UTF8S str) ->
          let b = [i|#{str}|] :: B.ByteString
              str' = [i|#{b}|] :: String
          in str' == str

      prop "should passthrough a conversion to lazy ByteString and back unchanged" $
        \(UTF8S str) ->
          let lb = [i|#{str}|] :: LB.ByteString
              str' = [i|#{lb}|] :: String
          in str' == 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" $
        \(t :: T.Text) ->
          let str = [i|#{t}|] :: String
              t' = [i|#{str}|] :: T.Text
          in t' == t

      prop "should passthrough a conversion to lazy Text and back unchanged" $
        \(t :: T.Text) ->
          let lt = [i|#{t}|] :: LT.Text
              t' = [i|#{lt}|] :: T.Text
          in t' == t

      prop "should passthrough a conversion to strict ByteString and back unchanged" $
        \(t :: T.Text) ->
          let b = [i|#{t}|] :: B.ByteString
              t' = [i|#{b}|] :: T.Text
          in t' == t

      prop "should passthrough a conversion to lazy ByteString and back unchanged" $
        \(t :: T.Text) ->
          let lb = [i|#{t}|] :: LB.ByteString
              t' = [i|#{lb}|] :: T.Text
          in t' == t

    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" $
        \(lt :: LT.Text) ->
          let str = [i|#{lt}|] :: String
              lt' = [i|#{str}|] :: LT.Text
          in lt' == lt

      prop "should passthrough a conversion to strict Text and back unchanged" $
        \(lt :: LT.Text) ->
          let t = [i|#{lt}|] :: T.Text
              lt' = [i|#{t}|] :: LT.Text
          in lt' == lt

      prop "should passthrough a conversion to strict ByteString and back unchanged" $
        \(lt :: LT.Text) ->
          let b = [i|#{lt}|] :: B.ByteString
              lt' = [i|#{b}|] :: LT.Text
          in lt' == lt

      prop "should passthrough a conversion to lazy ByteString and back unchanged" $
        \(lt :: LT.Text) ->
          let lb = [i|#{lt}|] :: LB.ByteString
              lt' = [i|#{lb}|] :: LT.Text
          in lt' == lt

    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" $
        \(b :: B.ByteString) ->
          let lb = [i|#{b}|] :: LB.ByteString
              b' = [i|#{lb}|] :: B.ByteString
          in b' == b

      context "and the ByteString is valid UTF8" $ do
        prop "should passthrough a conversion to String and back unchanged" $ do
          \(UTF8BS b) ->
            let str = [i|#{b}|] :: String
                b' = [i|#{str}|]
            in b' == b

        prop "should passthrough a conversion to strict Text and back unchanged" $ do
          \(UTF8BS b) ->
            let t = [i|#{b}|] :: T.Text
                b' = [i|#{t}|]
            in b' == b

        prop "should passthrough a conversion to lazy Text and back unchanged" $ do
          \(UTF8BS b) ->
            let lt = [i|#{b}|] :: LT.Text
                b' = [i|#{lt}|]
            in b' == 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" $
        \(lb :: LB.ByteString) ->
          let b = [i|#{lb}|] :: B.ByteString
              lb' = [i|#{b}|] :: LB.ByteString
          in lb' == lb

      context "and the ByteString is valid UTF8" $ do
        prop "should passthrough a conversion to String and back unchanged" $
          \(UTF8LBS lb) ->
            let str = [i|#{lb}|] :: String
                lb' = [i|#{str}|]
            in lb' == lb

        prop "should passthrough a conversion to strict Text and back unchanged" $
          \(UTF8LBS lb) ->
            let t = [i|#{lb}|] :: T.Text
                lb' = [i|#{t}|]
            in lb' == lb

        prop "should passthrough a conversion to lazy Text and back unchanged" $
          \(UTF8LBS lb) ->
            let lt = [i|#{lb}|] :: LT.Text
                lb' = [i|#{lt}|]
            in lb' == 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)

-- |
-- 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 { unUTF8BS :: B.ByteString }
  deriving newtype (Eq, Show)
newtype UTF8LazyByteString = UTF8LBS { unUTF8LBS :: LB.ByteString }
  deriving newtype (Eq, Show)

instance Arbitrary UTF8Char where
  arbitrary = UTF8C <$> arbitrary `suchThat` (\c -> c /= '\xFFFE' && c /= '\xFFFF')
  shrink (UTF8C c) = UTF8C <$> shrink 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