    {-# LANGUAGE TemplateHaskell #-}

    -- | This module exports TH utilities intended to be useful to users.
    --
    -- 'makeStore' can be used to generate a 'Store' instance for types,
    -- when all the type variables also require 'Store' instances. If some
    -- do not, then instead use "TH.Derive" like this:
    --
    -- @
    -- \{\-\# LANGUAGE TemplateHaskell \#\-\}
    -- \{\-\# LANGUAGE ScopedTypeVariables \#\-\}
    --
    -- import TH.Derive
    -- import Data.Store
    --
    -- data Foo a = Foo a | Bar Int
    --
    -- \$($(derive [d|
    --     instance Store a => Deriving (Store (Foo a))
    --     |]))
    -- @
    --
    -- Note that when used with datatypes that require type variables, the
    -- ScopedTypeVariables extension is required.
    --
    -- One advantage of using this Template Haskell definition of Store
    -- instances is that in some cases they can be faster than the instances
    -- defined via Generics. Specifically, sum types which can yield
    -- 'ConstSize' from 'size' will be faster when used in array-like types.
    -- The instances generated via generics always use 'VarSize' for sum
    -- types.
    module Data.Store.TH
        ( makeStore
        -- * Testing Store instances
        , smallcheckManyStore
        , checkRoundtrip
        , assertRoundtrip
        ) where

    import qualified Control.Monad.Fail as Fail
    import Data.Complex ()
    import Data.Store.Impl
    import Data.Typeable (Typeable, typeOf)
    import Debug.Trace (trace)
    import Language.Haskell.TH
    import Prelude
    import Test.Hspec
    import Test.Hspec.SmallCheck (property)
    import Test.SmallCheck
    import Data.Store.TH.Internal (makeStore)

    ------------------------------------------------------------------------
    -- Testing

    -- | Test a 'Store' instance using 'smallcheck' and 'hspec'.
    smallcheckManyStore :: Bool -> Int -> [TypeQ] -> ExpQ
    smallcheckManyStore :: Bool -> Int -> [TypeQ] -> ExpQ
    smallcheckManyStore verbose :: Bool
    verbose depth :: Int
    depth = [Q (String, Exp)] -> ExpQ
    smallcheckMany ([Q (String, Exp)] -> ExpQ)
    -> ([TypeQ] -> [Q (String, Exp)]) -> [TypeQ] -> ExpQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TypeQ -> Q (String, Exp)) -> [TypeQ] -> [Q (String, Exp)]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeQ -> Q (String, Exp)
    testRoundtrip
      where
        testRoundtrip :: TypeQ -> Q (String, Exp)
    testRoundtrip tyq :: TypeQ
    tyq = do
            Type
    ty <- TypeQ
    tyq
            Exp
    expr <- [e| property $ changeDepth (\_ -> depth) $ \x -> checkRoundtrip verbose (x :: $(return ty)) |]
            (String, Exp) -> Q (String, Exp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ("Roundtrips (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    ty String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")", Exp
    expr)

    assertRoundtrip :: (Eq a, Show a, Store a, Fail.MonadFail m, Typeable a) => Bool -> a -> m ()
    assertRoundtrip :: Bool -> a -> m ()
    assertRoundtrip verbose :: Bool
    verbose x :: a
    x
        | Bool -> a -> Bool
    forall a. (Eq a, Show a, Store a) => Bool -> a -> Bool
    checkRoundtrip Bool
    verbose a
    x = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = String -> m ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "Failed to roundtrip "  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TypeRep -> String
    forall a. Show a => a -> String
    show (a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    typeOf a
    x)

    -- | Check if a given value succeeds in decoding its encoded
    -- representation.
    checkRoundtrip :: (Eq a, Show a, Store a) => Bool -> a -> Bool
    checkRoundtrip :: Bool -> a -> Bool
    checkRoundtrip verbose :: Bool
    verbose x :: a
    x = Either PeekException a
    decoded Either PeekException a -> Either PeekException a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a -> Either PeekException a
    forall a b. b -> Either a b
    Right a
    x
      where
        encoded :: ByteString
    encoded = Bool -> String -> ByteString -> ByteString
    forall a. Show a => Bool -> String -> a -> a
    verboseTrace Bool
    verbose "encoded" (a -> ByteString
    forall a. Store a => a -> ByteString
    encode a
    x)
        decoded :: Either PeekException a
    decoded = Bool -> String -> Either PeekException a -> Either PeekException a
    forall a. Show a => Bool -> String -> a -> a
    verboseTrace Bool
    verbose "decoded" (ByteString -> Either PeekException a
    forall a. Store a => ByteString -> Either PeekException a
    decode ByteString
    encoded)

    smallcheckMany :: [Q (String, Exp)] -> ExpQ
    smallcheckMany :: [Q (String, Exp)] -> ExpQ
    smallcheckMany = [StmtQ] -> ExpQ
    doE ([StmtQ] -> ExpQ)
    -> ([Q (String, Exp)] -> [StmtQ]) -> [Q (String, Exp)] -> ExpQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Q (String, Exp) -> StmtQ) -> [Q (String, Exp)] -> [StmtQ]
    forall a b. (a -> b) -> [a] -> [b]
    map (\f :: Q (String, Exp)
    f -> Q (String, Exp)
    f Q (String, Exp) -> ((String, Exp) -> StmtQ) -> StmtQ
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \(name :: String
    name, expr :: Exp
    expr) -> ExpQ -> StmtQ
    noBindS [e| it name $ $(return expr) |])

    verboseTrace :: Show a => Bool -> String -> a -> a
    verboseTrace :: Bool -> String -> a -> a
    verboseTrace True msg :: String
    msg x :: a
    x = String -> a -> a
    forall a. String -> a -> a
    trace ((String, a) -> String
    forall a. Show a => a -> String
    show (String
    msg, a
    x)) a
    x
    verboseTrace False _ x :: a
    x = a
    x