{-# OPTIONS -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

import           Data.Word
import           Data.Char ( chr, isSpace )
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.List ( sort )
import           Data.Semigroup
import           Data.Foldable ( foldMap )
import qualified Data.HashMap.Strict as HM

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" Test.QuickCheck.Monadic
import "quickcheck-instances" Test.QuickCheck.Instances.ByteString ()
import "quickcheck-unicode" Test.QuickCheck.Unicode

import Data.String.Interpolate ( i, iii )
import Data.String.Interpolate.Conversion

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) -> 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
          ]