content: {-# LANGUAGE BangPatterns #-}
  
  module Codec.Binary.Bech32.THSpec
      ( spec
      ) where
  
  import Prelude
  
  import Codec.Binary.Bech32
      ( CharPosition (..)
      , HumanReadablePartError (..)
      , humanReadableCharMaxBound
      , humanReadableCharMinBound
      , humanReadablePartMaxLength
      , humanReadablePartMinLength
      )
  import Codec.Binary.Bech32.TH
      ( humanReadablePart )
  import Control.Monad
      ( forM_ )
  import Language.Haskell.TH.Quote
      ( QuasiQuoter (quoteExp) )
  import Language.Haskell.TH.Syntax
      ( Exp (..), runQ )
  import Test.Hspec
      ( Spec, describe, it, shouldSatisfy, shouldThrow )
  
  spec :: Spec
  spec =
      describe "Quasi-Quotations" $
  
          describe "Human-Readable Prefixes" $ do
              let mkHumanReadablePartExp = runQ . quoteExp humanReadablePart
  
              describe "Parsing valid human-readable prefixes should succeed." $
                  forM_ validHumanReadableParts $ \hrp ->
                      it (show hrp) $
                          mkHumanReadablePartExp hrp >>=
                              (`shouldSatisfy` isAppE)
  
              describe "Parsing invalid human-readable prefixes should fail." $
                  forM_ invalidHumanReadableParts $ \(hrp, expectedError) ->
                      it (show hrp) $
                          forceViaShowM (mkHumanReadablePartExp hrp)
                              `shouldThrow` (== expectedError)
  
  forceViaShowM :: (Monad m, Show a) => m a -> m a
  forceViaShowM f = do
      a <- f
      let !_ = length (show a)
      return a
  
  -- | Matches only function application expressions.
  --
  isAppE :: Exp -> Bool
  isAppE AppE {} = True
  isAppE _       = False
  
  -- | A selection of valid human-readable prefixes, that when parsed with the
  --   'humanReadablePart' quasiquoter should not result in an exception.
  --
  -- Note that this is not by any means intended to be an exhaustive list.
  -- The underlying parsing logic, provided by `humanReadablePartFromText`,
  -- is already tested in the `bech32` package.
  --
  validHumanReadableParts :: [String]
  validHumanReadableParts =
      [ replicate humanReadablePartMinLength humanReadableCharMinBound
      , replicate humanReadablePartMaxLength humanReadableCharMaxBound
      , "addr"
      ]
  
  -- | A selection of invalid human-readable prefixes, along with the errors that
  --   we expect to see if we attempt to parse them with the 'humanReadablePart'
  --   quasi-quoter.
  --
  -- Note that this is not by any means intended to be an exhaustive list.
  -- The underlying parsing logic, provided by `humanReadablePartFromText`,
  -- is already tested in the `bech32` package.
  --
  invalidHumanReadableParts :: [(String, HumanReadablePartError)]
  invalidHumanReadableParts =
      [ ( replicate (pred minLen) minChar
        , HumanReadablePartTooShort
        )
      , ( replicate (succ maxLen) maxChar
        , HumanReadablePartTooLong
        )
      , ( replicate (succ minLen) (pred minChar)
        , HumanReadablePartContainsInvalidChars (CharPosition <$> [0 .. minLen])
        )
      , ( replicate (succ minLen) (succ maxChar)
        , HumanReadablePartContainsInvalidChars (CharPosition <$> [0 .. minLen])
        )
      ]
    where
      minChar = humanReadableCharMinBound
      maxChar = humanReadableCharMaxBound
      minLen = humanReadablePartMinLength
      maxLen = humanReadablePartMaxLength
  