<commit_before>{-# LANGUAGE ExistentialQuantification #-}

module Data.Generics.Any where

import Control.Monad.State
import qualified Data.Data as D
import Data.Data hiding (toConstr, typeOf, dataTypeOf, isAlgType)
import Data.List
import Data.Maybe


type CtorName = String
type FieldName = String


readTupleType :: String -> Maybe Int
readTupleType x | "(" `isPrefixOf` x && ")" `isSuffixOf` x && all (== ',') y = Just $ length y
                | otherwise = Nothing
    where y = init $ tail x


---------------------------------------------------------------------
-- BASIC TYPES

data Any = forall a . Data a => Any a
type AnyT t = Any

instance Show Any where
    show = show . typeOf

fromAny :: Data a => Any -> a
fromAny (Any x) = case cast x of
    Just y -> y
    ~(Just y) -> error $ "Data.Generics.Any.fromAny: Failed to extract any, got " ++
                         show (D.typeOf x) ++ ", wanted " ++ show (D.typeOf y)


---------------------------------------------------------------------
-- SYB COMPATIBILITY

toConstr :: Any -> Constr
toConstr (Any x) = D.toConstr x

typeOf :: Any -> TypeRep
typeOf (Any x) = D.typeOf x

dataTypeOf :: Any -> DataType
dataTypeOf (Any x) = D.dataTypeOf x

isAlgType :: Any -> Bool
isAlgType = D.isAlgType . dataTypeOf

---------------------------------------------------------------------
-- TYPE STUFF

typeShell :: Any -> String
typeShell = tyconUQname . typeShellFull

typeShellFull :: Any -> String
typeShellFull = tyConString . typeRepTyCon . typeOf

typeName :: Any -> String
typeName = show . typeOf

---------------------------------------------------------------------
-- ANY PRIMITIVES

ctor :: Any -> CtorName
ctor = showConstr . toConstr

fields :: Any -> [String]
fields = constrFields . toConstr

children :: Any -> [Any]
children (Any x) = gmapQ Any x


compose0 :: Any -> CtorName -> Any
compose0 (Any x) c = Any $ fromConstr y `asTypeOf` x
    where Just y = readConstr (D.dataTypeOf x) c


recompose :: Any -> [Any] -> Any
recompose (Any x) cs = Any $ res `asTypeOf` x
    where res = flip evalState cs $ flip fromConstrM (D.toConstr x) $ do
                    c:cs <- get; put cs; return $ fromAny c


ctors :: Any -> [CtorName]
ctors = map showConstr . dataTypeConstrs . dataTypeOf
<commit_msg>Improve the error message for compose0<commit_after>{-# LANGUAGE ExistentialQuantification #-}

module Data.Generics.Any where

import Control.Monad.State
import qualified Data.Data as D
import Data.Data hiding (toConstr, typeOf, dataTypeOf, isAlgType)
import Data.List
import Data.Maybe


type CtorName = String
type FieldName = String


readTupleType :: String -> Maybe Int
readTupleType x | "(" `isPrefixOf` x && ")" `isSuffixOf` x && all (== ',') y = Just $ length y
                | otherwise = Nothing
    where y = init $ tail x


---------------------------------------------------------------------
-- BASIC TYPES

data Any = forall a . Data a => Any a
type AnyT t = Any

instance Show Any where
    show = show . typeOf

fromAny :: Data a => Any -> a
fromAny (Any x) = case cast x of
    Just y -> y
    ~(Just y) -> error $ "Data.Generics.Any.fromAny: Failed to extract any, got " ++
                         show (D.typeOf x) ++ ", wanted " ++ show (D.typeOf y)


---------------------------------------------------------------------
-- SYB COMPATIBILITY

toConstr :: Any -> Constr
toConstr (Any x) = D.toConstr x

typeOf :: Any -> TypeRep
typeOf (Any x) = D.typeOf x

dataTypeOf :: Any -> DataType
dataTypeOf (Any x) = D.dataTypeOf x

isAlgType :: Any -> Bool
isAlgType = D.isAlgType . dataTypeOf

---------------------------------------------------------------------
-- TYPE STUFF

typeShell :: Any -> String
typeShell = tyconUQname . typeShellFull

typeShellFull :: Any -> String
typeShellFull = tyConString . typeRepTyCon . typeOf

typeName :: Any -> String
typeName = show . typeOf

---------------------------------------------------------------------
-- ANY PRIMITIVES

ctor :: Any -> CtorName
ctor = showConstr . toConstr

fields :: Any -> [String]
fields = constrFields . toConstr

children :: Any -> [Any]
children (Any x) = gmapQ Any x


compose0 :: Any -> CtorName -> Any
compose0 (Any x) c = Any $ fromConstrB err y `asTypeOf` x
    where Just y = readConstr (D.dataTypeOf x) c
          err = error $ "Data.Generics.Any: Undefined field inside compose0, " ++ c ++ " :: " ++ show (Any x)


recompose :: Any -> [Any] -> Any
recompose (Any x) cs = Any $ res `asTypeOf` x
    where res = flip evalState cs $ flip fromConstrM (D.toConstr x) $ do
                    c:cs <- get; put cs; return $ fromAny c


ctors :: Any -> [CtorName]
ctors = map showConstr . dataTypeConstrs . dataTypeOf

{'fraction_non_alphanumeric': 0.22212729602733874, 'fraction_numerical': 0.0012815036309269544, 'mean_word_length': 1.8853974121996304, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 45, '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': '877074', 'n_tokens_mistral': 1443, 'n_tokens_neox': 1415, 'n_words': 491}