    {-# OPTIONS_HADDOCK not-home #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE TemplateHaskell #-}
    module Hedgehog.Internal.TH (
        TExpQ
      , discover
      , discoverPrefix
      ) where

    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified Data.Ord as Ord

    import           Hedgehog.Internal.Discovery
    import           Hedgehog.Internal.Property

    import           Language.Haskell.TH (Exp(..), Q, location, runIO
    #if MIN_VERSION_template_haskell(2,17,0)
      , CodeQ, joinCode, unTypeCode, unsafeCodeCoerce
    #endif
      )
    import           Language.Haskell.TH.Syntax (Loc(..), mkName
    #if !MIN_VERSION_template_haskell(2,17,0)
      , TExp, unsafeTExpCoerce, unTypeQ
    #endif
      )

    #if MIN_VERSION_template_haskell(2,17,0)
    type TExpQ a = CodeQ a
    #else
    -- Originally `Code` is a more polymorphic newtype wrapper, but for this module
    -- we can get away with just making it a type alias.
    type TExpQ a = Q (TExp a)
    joinCode :: Q (TExpQ a) -> TExpQ a
    joinCode = (>>= id)
    unsafeCodeCoerce :: Q Exp -> TExpQ a
    unsafeCodeCoerce = unsafeTExpCoerce
    unTypeCode ::  TExpQ a -> Q Exp
    unTypeCode = unTypeQ
    #endif

    -- | Discover all the properties in a module.
    --
    --   Functions starting with `prop_` are assumed to be properties.
    --
    discover :: TExpQ Group
    discover :: TExpQ Group
    discover = String -> TExpQ Group
    discoverPrefix String
    "prop_"

    discoverPrefix :: String -> TExpQ Group
    discoverPrefix :: String -> TExpQ Group
    discoverPrefix String
    prefix = Q (TExpQ Group) -> TExpQ Group
    forall (m :: * -> *) a. Monad m => m (Code m a) -> Code m a
    joinCode (Q (TExpQ Group) -> TExpQ Group) -> Q (TExpQ Group) -> TExpQ Group
    forall a b. (a -> b) -> a -> b
    $ do
      file <- Q String
    getCurrentFile
      properties <- Map.toList <$> runIO (readProperties prefix file)

      let
        startLine =
          ((a, PropertySource) -> LineNo)
    -> (a, PropertySource) -> (a, PropertySource) -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    Ord.comparing (((a, PropertySource) -> LineNo)
     -> (a, PropertySource) -> (a, PropertySource) -> Ordering)
    -> ((a, PropertySource) -> LineNo)
    -> (a, PropertySource)
    -> (a, PropertySource)
    -> Ordering
    forall a b. (a -> b) -> a -> b
    $
            Position -> LineNo
    posLine (Position -> LineNo)
    -> ((a, PropertySource) -> Position)
    -> (a, PropertySource)
    -> LineNo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            Pos String -> Position
    forall a. Pos a -> Position
    posPostion (Pos String -> Position)
    -> ((a, PropertySource) -> Pos String)
    -> (a, PropertySource)
    -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            PropertySource -> Pos String
    propertySource (PropertySource -> Pos String)
    -> ((a, PropertySource) -> PropertySource)
    -> (a, PropertySource)
    -> Pos String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
            (a, PropertySource) -> PropertySource
    forall a b. (a, b) -> b
    snd

        names =
          ((PropertyName, PropertySource) -> TExpQ (PropertyName, Property))
    -> [(PropertyName, PropertySource)]
    -> [TExpQ (PropertyName, Property)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PropertyName -> TExpQ (PropertyName, Property)
    mkNamedProperty (PropertyName -> TExpQ (PropertyName, Property))
    -> ((PropertyName, PropertySource) -> PropertyName)
    -> (PropertyName, PropertySource)
    -> TExpQ (PropertyName, Property)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PropertyName, PropertySource) -> PropertyName
    forall a b. (a, b) -> a
    fst) ([(PropertyName, PropertySource)]
     -> [TExpQ (PropertyName, Property)])
    -> [(PropertyName, PropertySource)]
    -> [TExpQ (PropertyName, Property)]
    forall a b. (a -> b) -> a -> b
    $
          ((PropertyName, PropertySource)
     -> (PropertyName, PropertySource) -> Ordering)
    -> [(PropertyName, PropertySource)]
    -> [(PropertyName, PropertySource)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    List.sortBy (PropertyName, PropertySource)
    -> (PropertyName, PropertySource) -> Ordering
    forall {a}. (a, PropertySource) -> (a, PropertySource) -> Ordering
    startLine [(PropertyName, PropertySource)]
    properties

      return [|| Group $$(moduleName) $$(listTE names) ||]

    mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
    mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
    mkNamedProperty PropertyName
    name =
      [|| (PropertyName
    name, $$(PropertyName -> TExpQ Property
    unsafeProperty PropertyName
    name)) ||]

    unsafeProperty :: PropertyName -> TExpQ Property
    unsafeProperty :: PropertyName -> TExpQ Property
    unsafeProperty =
      Q Exp -> TExpQ Property
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeCodeCoerce (Q Exp -> TExpQ Property)
    -> (PropertyName -> Q Exp) -> PropertyName -> TExpQ Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Exp -> Q Exp
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Exp -> Q Exp) -> (PropertyName -> Exp) -> PropertyName -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Exp
    VarE (Name -> Exp) -> (PropertyName -> Name) -> PropertyName -> Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName (String -> Name)
    -> (PropertyName -> String) -> PropertyName -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PropertyName -> String
    unPropertyName

    listTE :: [TExpQ a] -> TExpQ [a]
    listTE :: forall a. [TExpQ a] -> TExpQ [a]
    listTE [TExpQ a]
    xs =
      Q Exp -> Code Q [a]
    forall a (m :: * -> *). Quote m => m Exp -> Code m a
    unsafeCodeCoerce (Q Exp -> Code Q [a]) -> Q Exp -> Code Q [a]
    forall a b. (a -> b) -> a -> b
    $ Exp -> Q Exp
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Exp -> Q Exp) -> ([Exp] -> Exp) -> [Exp] -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Exp] -> Exp
    ListE ([Exp] -> Q Exp) -> Q [Exp] -> Q Exp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (TExpQ a -> Q Exp) -> [TExpQ a] -> Q [Exp]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse TExpQ a -> Q Exp
    forall a (m :: * -> *). Quote m => Code m a -> m Exp
    unTypeCode [TExpQ a]
    xs

    moduleName :: TExpQ GroupName
    moduleName :: TExpQ GroupName
    moduleName = Q (TExpQ GroupName) -> TExpQ GroupName
    forall (m :: * -> *) a. Monad m => m (Code m a) -> Code m a
    joinCode (Q (TExpQ GroupName) -> TExpQ GroupName)
    -> Q (TExpQ GroupName) -> TExpQ GroupName
    forall a b. (a -> b) -> a -> b
    $ do
      loc <- String -> GroupName
    GroupName (String -> GroupName) -> (Loc -> String) -> Loc -> GroupName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Loc -> String
    loc_module (Loc -> GroupName) -> Q Loc -> Q GroupName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Loc
    location
      return [|| loc ||]

    getCurrentFile :: Q FilePath
    getCurrentFile :: Q String
    getCurrentFile =
      Loc -> String
    loc_filename (Loc -> String) -> Q Loc -> Q String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q Loc
    location