<commit_before>{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Magma
-- Copyright   :  (C) 2012-2013 <NAME>
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Control.Lens.Internal.Magma
  ( Leaf(..)
  -- * Scoria
  , Scoria(..)
  , Molten(..)
  -- * Levels
  , Level(..)
  , Deepening(..), deepening
  , Flows(..)
  ) where

import Control.Applicative
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Data.Foldable
import Data.Int
import Data.Monoid
import Data.Profunctor.Unsafe
import Data.Traversable
import Data.Word
import Prelude hiding ((.),id)

------------------------------------------------------------------------------
-- Leaf
------------------------------------------------------------------------------

class Leaf i t | t -> i where
  leaf :: i -> a -> t a

------------------------------------------------------------------------------
-- Scoria
------------------------------------------------------------------------------

data Scoria i t b a where
  ScoriaAp   :: Scoria i (x -> y) b a -> Scoria i x b a -> Scoria i y b a
  ScoriaPure :: x -> Scoria i x b a
  ScoriaFmap :: (x -> y) -> Scoria i x b a -> Scoria i y b a
  ScoriaLeaf :: i -> a -> Scoria i b b a

instance Functor (Scoria i t b) where
  fmap f (ScoriaAp x y) = ScoriaAp (fmap f x) (fmap f y)
  fmap _ (ScoriaPure x) = ScoriaPure x
  fmap f (ScoriaFmap xy x) = ScoriaFmap xy (fmap f x)
  fmap f (ScoriaLeaf i a) = ScoriaLeaf i (f a)

instance Foldable (Scoria i t b) where
  foldMap f (ScoriaAp x y)   = foldMap f x `mappend` foldMap f y
  foldMap _ ScoriaPure{}     = mempty
  foldMap f (ScoriaFmap _ x) = foldMap f x
  foldMap f (ScoriaLeaf _ a) = f a

instance Traversable (Scoria i t b) where
  traverse f (ScoriaAp x y) = ScoriaAp <$> traverse f x <*> traverse f y
  traverse _ (ScoriaPure x) = pure (ScoriaPure x)
  traverse f (ScoriaFmap xy x) = ScoriaFmap xy <$> traverse f x
  traverse f (ScoriaLeaf i a) = ScoriaLeaf i <$> f a

instance b ~ t => Leaf i (Scoria i b t) where
  leaf = ScoriaLeaf

instance (Show i, Show a) => Show (Scoria i t b a) where
  showsPrec d (ScoriaAp x y) = showParen (d > 4) $
    showsPrec 4 x . showString " <*> " . showsPrec 5 y
  showsPrec d (ScoriaPure _) = showParen (d > 10) $
    showString "pure .."
  showsPrec d (ScoriaFmap _ x) = showParen (d > 4) $
    showString ".. <$> " . showsPrec 5 x
  showsPrec d (ScoriaLeaf i a) = showParen (d > 10) $
    showString "leaf " . showsPrec 11 i . showChar ' ' . showsPrec 11 a

-- | A non-reassociating initially encoded version of 'Bazaar'
newtype Molten i a b t = Molten { runMolten :: Scoria i t b a }

instance Functor (Molten i a b) where
  fmap f (Molten xs) = Molten (ScoriaFmap f xs)<commit_msg>Working Tailor<commit_after>{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Magma
-- Copyright   :  (C) 2012-2013 <NAME>
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  <NAME> <<EMAIL>>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Control.Lens.Internal.Magma
  ( Leaf(..)
  -- * Scoria
  , Scoria(..)
  , Molten(..)
  -- * Levels
  , Level(..)
  , Deepening(..), deepening
  , Flows(..)
  ) where

import Control.Applicative
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Data.Foldable
import Data.Int
import Data.Monoid
import Data.Profunctor.Unsafe
import Data.Traversable
import Data.Word
import Prelude hiding ((.),id)

------------------------------------------------------------------------------
-- Leaf
------------------------------------------------------------------------------

class Leaf i t | t -> i where
  leaf :: i -> a -> t a


------------------------------------------------------------------------------
-- Jacket
------------------------------------------------------------------------------

ltr :: Jacket i x b a -> Maybe x
ltr (JacketAp _ nl _ _ _) = nl
ltr (JacketPure x)        = Just x
ltr (JacketLeaf _ _)      = Nothing
{-# INLINE ltr #-}

rtl :: Jacket i x b a -> Maybe x
rtl (JacketAp _ _ nr _ _) = nr
rtl (JacketPure x)        = Just x
rtl (JacketLeaf _ _)      = Nothing
{-# INLINE rtl #-}

data Jacket i t b a where
  JacketAp   :: Int -> Int -> Maybe y -> Maybe y -> Jacket i (x -> y) b a -> Jacket i x b a -> Jacket i y b a
  JacketPure :: x -> Jacket i x b a
  JacketLeaf :: Int -> i -> a -> Jacket i b b a

instance Functor (Jacket i t b) where
  fmap f (JacketAp i j m n x y) = JacketAp i j m n (fmap f x) (fmap f y)
  fmap _ (JacketPure x) = JacketPure x
  fmap f (JacketLeaf i a) = JacketLeaf i (f a)

instance Foldable (Jacket i t b) where
  foldMap f (JacketAp _ _ _ x y)   = foldMap f x `mappend` foldMap f y
  foldMap _ JacketPure{}     = mempty
  foldMap f (JacketLeaf _ a) = f a

instance Traversable (Jacket i t b) where
  traverse f (JacketAp i m n x y) = JacketAp i m n <$> traverse f x <*> traverse f y
  traverse _ (JacketPure x) = pure (JacketPure x)
  traverse f (JacketLeaf i a) = JacketLeaf i <$> f a

instance b ~ t => Leaf i (Jacket i t b) where
  leaf = JacketLeaf

instance (Show i, Show a) => Show (Jacket i t b a) where
  showsPrec d (JacketAp _ _ _ x y) = showParen (d > 4) $
    showsPrec 4 x . showString " <*> " . showsPrec 5 y
  showsPrec d (JacketPure _) = showParen (d > 10) $
    showString "pure .."
  showsPrec d (JacketLeaf i a) = showParen (d > 10) $
    showString "leaf " . showsPrec 11 i . showChar ' ' . showsPrec 11 a

------------------------------------------------------------------------------
-- Tailor
------------------------------------------------------------------------------

newtype Tailor i a b t = Tailor Int (Int -> Jacket i t b a)

instance Functor (Tailor i a b) where
  fmap f (Tailor w k) = Tailor w $ \o -> let ko = k o in JacketAp m (ltr ko) (rtl ko) (JacketPure f) ko

instance Applicative (Molten i a b) where
  pure a = Tailor 0 $ \_ -> Pure a
  Molten xs <*> Molten ys = Molten (ScoriaAp xs ys)


------------------------------------------------------------------------------
-- Scoria
------------------------------------------------------------------------------

data Scoria i t b a where
  ScoriaAp   :: Scoria i (x -> y) b a -> Scoria i x b a -> Scoria i y b a
  ScoriaPure :: x -> Scoria i x b a
  ScoriaFmap :: (x -> y) -> Scoria i x b a -> Scoria i y b a
  ScoriaLeaf :: i -> a -> Scoria i b b a

instance Functor (Scoria i t b) where
  fmap f (ScoriaAp x y) = ScoriaAp (fmap f x) (fmap f y)
  fmap _ (ScoriaPure x) = ScoriaPure x
  fmap f (ScoriaFmap xy x) = ScoriaFmap xy (fmap f x)
  fmap f (ScoriaLeaf i a) = ScoriaLeaf i (f a)

instance Foldable (Scoria i t b) where
  foldMap f (ScoriaAp x y)   = foldMap f x `mappend` foldMap f y
  foldMap _ ScoriaPure{}     = mempty
  foldMap f (ScoriaFmap _ x) = foldMap f x
  foldMap f (ScoriaLeaf _ a) = f a

instance Traversable (Scoria i t b) where
  traverse f (ScoriaAp x y) = ScoriaAp <$> traverse f x <*> traverse f y
  traverse _ (ScoriaPure x) = pure (ScoriaPure x)
  traverse f (ScoriaFmap xy x) = ScoriaFmap xy <$> traverse f x
  traverse f (ScoriaLeaf i a) = ScoriaLeaf i <$> f a

instance b ~ t => Leaf i (Scoria i t b) where
  leaf = ScoriaLeaf

instance (Show i, Show a) => Show (Scoria i t b a) where
  showsPrec d (ScoriaAp x y) = showParen (d > 4) $
    showsPrec 4 x . showString " <*> " . showsPrec 5 y
  showsPrec d (ScoriaPure _) = showParen (d > 10) $
    showString "pure .."
  showsPrec d (ScoriaFmap _ x) = showParen (d > 4) $
    showString ".. <$> " . showsPrec 5 x
  showsPrec d (ScoriaLeaf i a) = showParen (d > 10) $
    showString "leaf " . showsPrec 11 i . showChar ' ' . showsPrec 11 a

------------------------------------------------------------------------------
-- Molten
------------------------------------------------------------------------------

-- | A non-reassociating initially encoded version of 'Bazaar'
newtype Molten i a b t = Molten { runMolten :: Scoria i t b a }

instance Functor (Molten i a b) where
  fmap f (Molten xs) = Molten (ScoriaFmap f xs)
{'fraction_non_alphanumeric': 0.2550616197183099, 'fraction_numerical': 0.006161971830985915, 'mean_word_length': 1.6467676179382644, 'pattern_counts': {'":': 0, '<': 28, '<?xml version=': 0, '>': 85, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5089320', 'n_tokens_mistral': 3156, 'n_tokens_neox': 3048, 'n_words': 1084}