<commit_before>--------------------------------------------------------------------------------
-- | Internally used compiler module
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler.Internal
    ( Dependencies
    , DependencyEnvironment (..)
    , CompilerEnvironment (..)
    , Throwing
    , CompilerM (..)
    , Compiler (..)
    , runCompilerJob
    , runCompilerDependencies
    , fromJob
    , fromDependencies
    , fromDependency
    ) where


--------------------------------------------------------------------------------
import           Control.Applicative          (Alternative (..), Applicative,
                                               pure, (<$>), (<*>))
import           Control.Arrow
import           Control.Category             (Category, id, (.))
import           Control.Monad                (liftM2, (<=<))
import           Control.Monad.Error          (ErrorT, catchError, runErrorT,
                                               throwError)
import           Control.Monad.Reader         (Reader, ReaderT, ask, runReader,
                                               runReaderT)
import           Data.Set                     (Set)
import qualified Data.Set                     as S
import           Prelude                      hiding (id, (.))


--------------------------------------------------------------------------------
import           Hakyll.Core.Identifier
import           Hakyll.Core.Logger
import           Hakyll.Core.ResourceProvider
import           Hakyll.Core.Routes
import           Hakyll.Core.Store
import           Hakyll.Core.Util.Arrow


--------------------------------------------------------------------------------
-- | A set of dependencies
type Dependencies = Set (Identifier ())


--------------------------------------------------------------------------------
-- | Environment in which the dependency analyzer runs
data DependencyEnvironment = DependencyEnvironment
    { -- | Target identifier
      dependencyIdentifier :: Identifier ()
    , -- | List of available identifiers we can depend upon
      dependencyUniverse   :: [Identifier ()]
    }


--------------------------------------------------------------------------------
-- | Environment in which a compiler runs
data CompilerEnvironment = CompilerEnvironment
    { -- | Target identifier
      compilerIdentifier       :: Identifier ()
    , -- | Resource provider
      compilerResourceProvider :: ResourceProvider
    , -- | List of all known identifiers
      compilerUniverse         :: [Identifier ()]
    , -- | Site routes
      compilerRoutes           :: Routes
    , -- | Compiler store
      compilerStore            :: Store
    , -- | Flag indicating if the underlying resource was modified
      compilerResourceModified :: Bool
    , -- | Logger
      compilerLogger           :: Logger
    }


--------------------------------------------------------------------------------
-- | A calculation possibly throwing an error
type Throwing a = Either String a


--------------------------------------------------------------------------------
-- | The compiler monad
newtype CompilerM a = CompilerM
    { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a
    } deriving (Monad, Functor, Applicative)


--------------------------------------------------------------------------------
-- | The compiler arrow
data Compiler a b = Compiler
    { compilerDependencies :: Reader DependencyEnvironment Dependencies
    , compilerJob          :: a -> CompilerM b
    }


--------------------------------------------------------------------------------
instance Functor (Compiler a) where
    fmap f ~(Compiler d j) = Compiler d $ fmap f . j


--------------------------------------------------------------------------------
instance Applicative (Compiler a) where
    pure = fromJob . const . return
    ~(Compiler d1 j1) <*> ~(Compiler d2 j2) =
        Compiler (liftM2 S.union d1 d2) $ \x -> j1 x <*> j2 x


--------------------------------------------------------------------------------
instance Alternative (Compiler a) where
    empty = fromJob $ const $ CompilerM $
        throwError "Hakyll.Core.Compiler.Internal: empty alternative"
    ~(Compiler d1 j1) <|> ~(Compiler d2 j2) =
        Compiler (liftM2 S.union d1 d2) $ \x -> CompilerM $
            catchError (unCompilerM $ j1 x) (\_ -> unCompilerM $ j2 x)


--------------------------------------------------------------------------------
instance Category Compiler where
    id = Compiler (return S.empty) return
    ~(Compiler d1 j1) . ~(Compiler d2 j2) =
        Compiler (liftM2 S.union d1 d2) (j1 <=< j2)


--------------------------------------------------------------------------------
instance Arrow Compiler where
    arr f = fromJob (return . f)
    first ~(Compiler d j) = Compiler d $ \(x, y) -> do
        x' <- j x
        return (x', y)


--------------------------------------------------------------------------------
instance ArrowChoice Compiler where
    left ~(Compiler d j) = Compiler d $ \e -> case e of
        Left l  -> Left  <$> j l
        Right r -> Right <$> return r
    -- Defined here for efficiency
    ~(Compiler d1 j1) ||| ~(Compiler d2 j2) = Compiler (liftM2 S.union d1 d2) $
        \e -> case e of Left x  -> j1 x; Right y -> j2 y


--------------------------------------------------------------------------------
instance ArrowMap Compiler where
    mapA (Compiler d j) = Compiler d $ mapM j

<commit_msg>More efficient instances for compiler<commit_after>--------------------------------------------------------------------------------
-- | Internally used compiler module
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler.Internal
    ( Dependencies
    , DependencyEnvironment (..)
    , CompilerEnvironment (..)
    , Throwing
    , CompilerM (..)
    , Compiler (..)
    , runCompilerJob
    , runCompilerDependencies
    , fromJob
    , fromDependencies
    , fromDependency
    ) where


--------------------------------------------------------------------------------
import           Control.Applicative          (Alternative (..), Applicative,
                                               pure, (<$>), (<*>))
import           Control.Arrow
import           Control.Category             (Category, id, (.))
import           Control.Monad                (liftM2, (<=<))
import           Control.Monad.Error          (ErrorT, catchError, runErrorT,
                                               throwError)
import           Control.Monad.Reader         (Reader, ReaderT, ask, runReader,
                                               runReaderT)
import           Data.Set                     (Set)
import qualified Data.Set                     as S
import           Prelude                      hiding (id, (.))


--------------------------------------------------------------------------------
import           Hakyll.Core.Identifier
import           Hakyll.Core.Logger
import           Hakyll.Core.ResourceProvider
import           Hakyll.Core.Routes
import           Hakyll.Core.Store
import           Hakyll.Core.Util.Arrow


--------------------------------------------------------------------------------
-- | A set of dependencies
type Dependencies = Set (Identifier ())


--------------------------------------------------------------------------------
-- | Environment in which the dependency analyzer runs
data DependencyEnvironment = DependencyEnvironment
    { -- | Target identifier
      dependencyIdentifier :: Identifier ()
    , -- | List of available identifiers we can depend upon
      dependencyUniverse   :: [Identifier ()]
    }


--------------------------------------------------------------------------------
-- | Environment in which a compiler runs
data CompilerEnvironment = CompilerEnvironment
    { -- | Target identifier
      compilerIdentifier       :: Identifier ()
    , -- | Resource provider
      compilerResourceProvider :: ResourceProvider
    , -- | List of all known identifiers
      compilerUniverse         :: [Identifier ()]
    , -- | Site routes
      compilerRoutes           :: Routes
    , -- | Compiler store
      compilerStore            :: Store
    , -- | Flag indicating if the underlying resource was modified
      compilerResourceModified :: Bool
    , -- | Logger
      compilerLogger           :: Logger
    }


--------------------------------------------------------------------------------
-- | A calculation possibly throwing an error
type Throwing a = Either String a


--------------------------------------------------------------------------------
-- | The compiler monad
newtype CompilerM a = CompilerM
    { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a
    } deriving (Monad, Functor, Applicative)


--------------------------------------------------------------------------------
-- | The compiler arrow
data Compiler a b = Compiler
    { compilerDependencies :: Reader DependencyEnvironment Dependencies
    , compilerJob          :: a -> CompilerM b
    }


--------------------------------------------------------------------------------
instance Functor (Compiler a) where
    fmap f (Compiler d j) = Compiler d $ fmap f . j
    {-# INLINE fmap #-}


--------------------------------------------------------------------------------
instance Applicative (Compiler a) where
    pure = fromJob . const . return
    {-# INLINE pure #-}

    Compiler d1 j1 <*> Compiler d2 j2 =
        Compiler (liftM2 S.union d1 d2) $ \x -> j1 x <*> j2 x
    {-# INLINE (<*>) #-}


--------------------------------------------------------------------------------
instance Alternative (Compiler a) where
    empty = fromJob $ const $ CompilerM $
        throwError "Hakyll.Core.Compiler.Internal: empty alternative"

    Compiler d1 j1 <|> Compiler d2 j2 =
        Compiler (liftM2 S.union d1 d2) $ \x -> CompilerM $
            catchError (unCompilerM $ j1 x) (\_ -> unCompilerM $ j2 x)
    {-# INLINE (<|>) #-}


--------------------------------------------------------------------------------
instance Category Compiler where
    id = Compiler (return S.empty) return
    {-# INLINE id #-}

    Compiler d1 j1 . Compiler d2 j2 =
        Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
    {-# INLINE (.) #-}


--------------------------------------------------------------------------------
instance Arrow Compiler where
    arr f = fromJob (return . f)
    {-# INLINE arr #-}

    first (Compiler d j) = Compiler d $ \(x, y) -> do
        x' <- j x
        return (x', y)
    {-# INLINE first #-}

    second (Compiler d j) = Compiler d $ \(x, y) -> do
        y' <- j y
        return (x, y')
    {-# INLINE second #-}

    Compiler d1 j1 *** Compiler d2 j2 =
        Compiler (liftM2 S.union d1 d2) $ \(x, y) -> do
            x' <- j1 x
            y' <- j2 y
            return (x', y')
    {-# INLINE (***) #-}

    Compiler d1 j1 &&& Compiler d2 j2 =
        Compiler (liftM2 S.union d1 d2) $ \x -> do
            y1 <- j1 x
            y2 <- j2 x
            return (y1, y2)
    {-# INLINE (&&&) #-}


--------------------------------------------------------------------------------
instance ArrowChoice Compiler where
    left (Compiler d j) = Compiler d $ \e -> case e of
        Left l  -> Left  <$> j l
        Right r -> Right <$> return r
    {-# INLINE left #-}

    Compiler d1 j1 ||| Compiler d2 j2 = Compiler (liftM2 S.union d1 d2) $
        \e -> case e of Left x  -> j1 x; Right y -> j2 y
    {-# INLINE (|||) #-}


--------------------------------------------------------------------------------
instance ArrowMap Compiler where
    mapA (Compiler d j) = Compiler d $ mapM j
    {-# INLINE mapA #-}


{'fraction_non_alphanumeric': 0.2984194788551901, 'fraction_numerical': 0.008201623237932507, 'mean_word_length': 1.0294729542302359, 'pattern_counts': {'":': 0, '<': 34, '<?xml version=': 0, '>': 44, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 12, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2631878', 'n_tokens_mistral': 2776, 'n_tokens_neox': 2619, 'n_words': 836}