<commit_before>-- |
-- Module      : Test.Speculate.Expr.Core
-- Copyright   : (c) 2016-2017 <NAME>
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : <NAME> <<EMAIL>>
--
-- This module is part of Speculate.
--
-- Defines the 'Expr' type and basic operations on it.
module Test.Speculate.Expr.Core
  ( Expr (..)
  -- * Smart constructors
  , constant
  , showConstant
  , var
  , hole
  , holeOfTy
  , ($$)

  -- * Smart destructors
  , evaluate
  , eval
  , typ
  , etyp 

  -- * Queries
  , typeCorrect
  , arity
  , holes
  , vars
  , consts
  , atomicConstants
  , subexprs
  , subexprsV
  , isSub
  , hasVar
  , unfoldApp
  , isConstantNamed

  -- * Properties of expressions
  , lengthE
  , depthE
  , countVar
  , countVars
  , unrepeatedVars
  , isAssignment
  , lexicompare
  , lexicompareBy
  , compareComplexity
  , compareComplexityThen

  -- * Useful expressions
  , falseE

  -- * Showing
  , showExpr
  , showPrecExpr
  , showsPrecExpr
  , showOpExpr
  , showsOpExpr
  , eqExprCommuting
  )
where

import Data.List (intercalate, find)
import Data.Maybe (fromMaybe, isJust, catMaybes)
import Data.Function (on)
import Data.Monoid ((<>))

import Data.Dynamic
import Test.LeanCheck
import Test.Speculate.Utils


-- | An encoded Haskell functional-application expression for use by Speculate.
data Expr = Constant String Dynamic
          | Var String TypeRep
          | Expr :$ Expr

-- | Encode a constant Haskell expression for use by Speculate.
--   It takes a string representation of a value and a value, returning an
--   'Expr'.  Examples:
--
-- > constant "0" 0
-- > constant "'a'" 'a'
-- > constant "True" True
-- > constant "id" (id :: Int -> Int)
-- > constant "(+)" ((+) :: Int -> Int -> Int)
-- > constant "sort" (sort :: [Bool] -> [Bool])
constant :: Typeable a => String -> a -> Expr
constant s x = Constant s (toDyn x)

-- | A shorthand for 'constant' to be used on values that are 'Show' instances.
--   Examples:
--
-- > showConstant 0     =  constant "0" 0
-- > showConstant 'a'   =  constant "'a'" 'a' 
-- > showConstant True  =  constant "True" True
showConstant :: (Typeable a, Show a) => a -> Expr
showConstant x = constant (show x) x

-- | @var "x" (undefined :: Ty)@ returns a variable of type 'Ty' named "x"
var :: (Listable a, Typeable a) => String -> a -> Expr
var s a = Var s (typeOf a)

-- | __(intended for advanced users)__
--
-- @hole (undefined :: Ty)@ returns a hole of type 'Ty'
--
-- By convention, a Hole is a variable named with the empty string.
hole :: (Listable a, Typeable a) => a -> Expr
hole = holeOfTy . typeOf

holeOfTy :: TypeRep -> Expr
holeOfTy = Var ""

-- | 'Just' an 'Expr' application if the types match,
--   'Nothing' otherwise.
($$) :: Expr -> Expr -> Maybe Expr
e1 $$ e2 =
  case typ e1 `funResultTy` typ e2 of
    Nothing -> Nothing
    Just _  -> Just $ e1 :$ e2


-- Deprecated smart constructors:



-- quick and dirty show instance
instance Show Expr where
  showsPrec d e = showParen (d > 10)
                $ showsPrecExpr 0 e
                . showString " :: "
                . shows (typ e)
                . showString (showHoles e)
    where
    showHoles e = case holes e of
                    [] -> ""
                    hs -> "  (holes: " ++ intercalate ", " (map show hs) ++ ")"

showsPrecExpr :: Int -> Expr -> String -> String
showsPrecExpr d (Constant s _) | atomic s && isInfixedPrefix s = showString $ toPrefix s
showsPrecExpr d (Constant s _) = showParen sp $ showString s
  where sp = if atomic s then isInfix s else maybe True (d >) $ outernmostPrec s
showsPrecExpr d (Var "" _)     = showString "_" -- a hole
showsPrecExpr d (Var s _)      = showParen (isInfix s) $ showString s
showsPrecExpr d ((Constant ":" _ :$ e1@(Constant _ _)) :$ e2)
  | typ e1 == typeOf (undefined :: Char) =
  case showsPrecExpr 0 e2 "" of
    '\"':cs  -> showString ("\"" ++ (init . tail) (showsPrecExpr 0 e1 "") ++ cs)
    cs -> showParen (d > prec ":")
        $ showsOpExpr ":" e1 . showString ":" . showsTailExpr e2
showsPrecExpr d ((Constant ":" _ :$ e1) :$ e2) =
  case showsPrecExpr 0 e2 "" of
    "[]" -> showString "[" . showsPrecExpr 0 e1 . showString "]"
    '[':cs -> showString "[" . showsPrecExpr 0 e1 . showString "," . showString cs
    cs -> showParen (d > prec ":")
        $ showsOpExpr ":" e1 . showString ":" . showsTailExpr e2
showsPrecExpr d ((Constant "," _ :$ e1) :$ e2) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString ")"
showsPrecExpr d (((Constant ",," _ :$ e1) :$ e2) :$ e3) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString "," . showsPrecExpr 0 e3
  . showString ")"
showsPrecExpr d ((((Constant ",,," _ :$ e1) :$ e2) :$ e3) :$ e4) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString "," . showsPrecExpr 0 e3
  . showString "," . showsPrecExpr 0 e4
  . showString ")"<commit_msg>showing of list expressions a bit more efficient<commit_after>-- |
-- Module      : Test.Speculate.Expr.Core
-- Copyright   : (c) 2016-2017 <NAME>
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : <NAME> <<EMAIL>>
--
-- This module is part of Speculate.
--
-- Defines the 'Expr' type and basic operations on it.
module Test.Speculate.Expr.Core
  ( Expr (..)
  -- * Smart constructors
  , constant
  , showConstant
  , var
  , hole
  , holeOfTy
  , ($$)

  -- * Smart destructors
  , evaluate
  , eval
  , typ
  , etyp 

  -- * Queries
  , typeCorrect
  , arity
  , holes
  , vars
  , consts
  , atomicConstants
  , subexprs
  , subexprsV
  , isSub
  , hasVar
  , unfoldApp
  , isConstantNamed

  -- * Properties of expressions
  , lengthE
  , depthE
  , countVar
  , countVars
  , unrepeatedVars
  , isAssignment
  , lexicompare
  , lexicompareBy
  , compareComplexity
  , compareComplexityThen

  -- * Useful expressions
  , falseE

  -- * Showing
  , showExpr
  , showPrecExpr
  , showsPrecExpr
  , showOpExpr
  , showsOpExpr
  , eqExprCommuting
  )
where

import Data.List (intercalate, find)
import Data.Maybe (fromMaybe, isJust, catMaybes)
import Data.Function (on)
import Data.Monoid ((<>))

import Data.Dynamic
import Test.LeanCheck
import Test.Speculate.Utils


-- | An encoded Haskell functional-application expression for use by Speculate.
data Expr = Constant String Dynamic
          | Var String TypeRep
          | Expr :$ Expr

-- | Encode a constant Haskell expression for use by Speculate.
--   It takes a string representation of a value and a value, returning an
--   'Expr'.  Examples:
--
-- > constant "0" 0
-- > constant "'a'" 'a'
-- > constant "True" True
-- > constant "id" (id :: Int -> Int)
-- > constant "(+)" ((+) :: Int -> Int -> Int)
-- > constant "sort" (sort :: [Bool] -> [Bool])
constant :: Typeable a => String -> a -> Expr
constant s x = Constant s (toDyn x)

-- | A shorthand for 'constant' to be used on values that are 'Show' instances.
--   Examples:
--
-- > showConstant 0     =  constant "0" 0
-- > showConstant 'a'   =  constant "'a'" 'a' 
-- > showConstant True  =  constant "True" True
showConstant :: (Typeable a, Show a) => a -> Expr
showConstant x = constant (show x) x

-- | @var "x" (undefined :: Ty)@ returns a variable of type 'Ty' named "x"
var :: (Listable a, Typeable a) => String -> a -> Expr
var s a = Var s (typeOf a)

-- | __(intended for advanced users)__
--
-- @hole (undefined :: Ty)@ returns a hole of type 'Ty'
--
-- By convention, a Hole is a variable named with the empty string.
hole :: (Listable a, Typeable a) => a -> Expr
hole = holeOfTy . typeOf

holeOfTy :: TypeRep -> Expr
holeOfTy = Var ""

-- | 'Just' an 'Expr' application if the types match,
--   'Nothing' otherwise.
($$) :: Expr -> Expr -> Maybe Expr
e1 $$ e2 =
  case typ e1 `funResultTy` typ e2 of
    Nothing -> Nothing
    Just _  -> Just $ e1 :$ e2


-- Deprecated smart constructors:



-- quick and dirty show instance
instance Show Expr where
  showsPrec d e = showParen (d > 10)
                $ showsPrecExpr 0 e
                . showString " :: "
                . shows (typ e)
                . showString (showHoles e)
    where
    showHoles e = case holes e of
                    [] -> ""
                    hs -> "  (holes: " ++ intercalate ", " (map show hs) ++ ")"

showsPrecExpr :: Int -> Expr -> String -> String
showsPrecExpr d (Constant s _) | atomic s && isInfixedPrefix s = showString $ toPrefix s
showsPrecExpr d (Constant s _) = showParen sp $ showString s
  where sp = if atomic s then isInfix s else maybe True (d >) $ outernmostPrec s
showsPrecExpr d (Var "" _)     = showString "_" -- a hole
showsPrecExpr d (Var s _)      = showParen (isInfix s) $ showString s
showsPrecExpr d ((Constant ":" _ :$ e1@(Constant _ _)) :$ e2)
  | typ e1 == typeOf (undefined :: Char) =
  case showsTailExpr e2 "" of
    '\"':cs  -> showString ("\"" ++ (init . tail) (showsPrecExpr 0 e1 "") ++ cs)
    cs -> showParen (d > prec ":")
        $ showsOpExpr ":" e1 . showString ":" . showString cs
showsPrecExpr d ((Constant ":" _ :$ e1) :$ e2) =
  case showsTailExpr e2 "" of
    "[]" -> showString "[" . showsPrecExpr 0 e1 . showString "]"
    '[':cs -> showString "[" . showsPrecExpr 0 e1 . showString "," . showString cs
    cs -> showParen (d > prec ":")
        $ showsOpExpr ":" e1 . showString ":" . showString cs
showsPrecExpr d ((Constant "," _ :$ e1) :$ e2) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString ")"
showsPrecExpr d (((Constant ",," _ :$ e1) :$ e2) :$ e3) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString "," . showsPrecExpr 0 e3
  . showString ")"
showsPrecExpr d ((((Constant ",,," _ :$ e1) :$ e2) :$ e3) :$ e4) =
    showString "(" . showsPrecExpr 0 e1
  . showString "," . showsPrecExpr 0 e2
  . showString "," . showsPrecExpr 0 e3
  . showString "," . showsPrecExpr 0 e4
  . showString ")"
{'fraction_non_alphanumeric': 0.14292914020764036, 'fraction_numerical': 0.013506702953331317, 'mean_word_length': 2.553724928366762, 'pattern_counts': {'":': 16, '<': 13, '<?xml version=': 0, '>': 97, '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': '7297202', 'n_tokens_mistral': 3487, 'n_tokens_neox': 3332, 'n_words': 1079}