-- |
-- Module      : Conjure.Spec
-- Copyright   : (c) 2021 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- An internal module of 'Conjure',
-- a library for Conjuring function implementations
-- from tests or partial definitions.
-- (a.k.a.: functional inductive programming)
module Conjure.Spec
  ( Spec1
  , Spec2
  , Spec3
  , (-=)
  , conjure1
  , conjure2
  , conjure3
  , conjure1With
  , conjure2With
  , conjure3With
  )
where

import Conjure.Engine
import Conjure.Conjurable
import Conjure.Utils


-- | A partial specification of a function with one argument:
--
-- > sumSpec :: Spec1 [Int] Int
-- > sumSpec  =
-- >   [ []      -= 0
-- >   , [1,2]   -= 3
-- >   , [3,4,5] -= 12
-- >   ]
--
-- To be passed as one of the arguments to 'conjure1'.
type Spec1 a b     = [(a,b)]


-- | A partial specification of a function with two arguments:
--
-- > appSpec :: Spec2 [Int] [Int] [Int]
-- > appSpec  =
-- >   [ (,) []      [0,1]   -= [0,1]
-- >   , (,) [2,3]   []      -= [2,3]
-- >   , (,) [4,5,6] [7,8,9] -= [4,5,6,7,8,9]
-- >   ]
--
-- To be passed as one of the arguments to 'conjure2'.
type Spec2 a b c   = [((a,b),c)]


-- | A partial specification of a function with three arguments.
--
-- To be passed as one of the arguments to 'conjure3'
type Spec3 a b c d = [((a,b,c),d)]


-- | To be used when constructing specifications:
--   'Spec1',
--   'Spec2' and
--   'Spec3'.
(-=) :: a -> b -> (a,b)
-= :: a -> b -> (a, b)
(-=)  =  (,)


-- | Conjures a one argument function from a specification.
--
-- Given:
--
-- > sumSpec :: Spec1 [Int] Int
-- > sumSpec  =
-- >   [ []      -= 0
-- >   , [1,2]   -= 3
-- >   , [3,4,5] -= 12
-- >   ]
--
-- > sumPrimitives :: [Expr]
-- > sumPrimitives  =
-- >   [ value "null" (null :: [Int] -> Bool)
-- >   , val (0::Int)
-- >   , value "+"    ((+) :: Int -> Int -> Int)
-- >   , value "head" (head :: [Int] -> Int)
-- >   , value "tail" (tail :: [Int] -> [Int])
-- >   ]
--
-- Then:
--
-- > > conjure1 "sum" sumSpec sumPrimitives
-- > sum :: [Int] -> Int
-- > -- testing 3 combinations of argument values
-- > -- ...
-- > -- looking through 189/465 candidates of size 10
-- > xs ++ ys  =  if null xs then ys else head xs:(tail xs ++ ys)
--
-- (cf. 'Spec1', 'conjure1With')
conjure1 :: (Eq a, Eq b, Show a, Conjurable a, Conjurable b)
         => String -> Spec1 a b -> [Expr] -> IO ()
conjure1 :: String -> Spec1 a b -> [Expr] -> IO ()
conjure1  =  Args -> String -> Spec1 a b -> [Expr] -> IO ()
forall a b.
(Eq a, Eq b, Show a, Conjurable a, Conjurable b) =>
Args -> String -> Spec1 a b -> [Expr] -> IO ()
conjure1With Args
args


-- | Conjures a two argument function from a specification.
--
-- Given:
--
-- > appSpec :: Spec2 [Int] [Int] [Int]
-- > appSpec  =
-- >   [ (,) []      [0,1]   -= [0,1]
-- >   , (,) [2,3]   []      -= [2,3]
-- >   , (,) [4,5,6] [7,8,9] -= [4,5,6,7,8,9]
-- >   ]
--
-- > appPrimitives :: [Expr]
-- > appPrimitives =
-- >   [ value "null" (null :: [Int] -> Bool)
-- >   , value ":"    ((:) :: Int -> [Int] -> [Int])
-- >   , value "head" (head :: [Int] -> Int)
-- >   , value "tail" (tail :: [Int] -> [Int])
-- >   ]
--
-- Then:
--
-- > > conjure2 "++" appSpec appPrimitives
-- > (++) :: [Int] -> [Int] -> [Int]
-- > -- testing 3 combinations of argument values
-- > -- ...
-- > -- looking through 26166/57090 candidates of size 11
-- > xs ++ ys  =  if null xs then ys else head xs:(tail xs ++ ys)
--
-- (cf. 'Spec2', 'conjure2With')
conjure2 :: ( Conjurable a, Eq a, Show a
            , Conjurable b, Eq b, Show b
            , Conjurable c, Eq c
            ) => String -> Spec2 a b c -> [Expr] -> IO ()
conjure2 :: String -> Spec2 a b c -> [Expr] -> IO ()
conjure2  =  Args -> String -> Spec2 a b c -> [Expr] -> IO ()
forall a b c.
(Conjurable a, Eq a, Show a, Conjurable b, Eq b, Show b,
 Conjurable c, Eq c) =>
Args -> String -> Spec2 a b c -> [Expr] -> IO ()
conjure2With Args
args


-- | Conjures a three argument function from a specification.
--
-- (cf. 'Spec3', 'conjure3With')
conjure3 :: ( Conjurable a, Eq a, Show a
            , Conjurable b, Eq b, Show b
            , Conjurable c, Eq c, Show c
            , Conjurable d, Eq d
            ) => String -> Spec3 a b c d -> [Expr] -> IO ()
conjure3 :: String -> Spec3 a b c d -> [Expr] -> IO ()
conjure3  =  Args -> String -> Spec3 a b c d -> [Expr] -> IO ()
forall a b c d.
(Conjurable a, Eq a, Show a, Conjurable b, Eq b, Show b,
 Conjurable c, Eq c, Show c, Conjurable d, Eq d) =>
Args -> String -> Spec3 a b c d -> [Expr] -> IO ()
conjure3With Args
args


-- | Like 'conjure1' but allows setting options through 'Args'/'args'.
conjure1With :: (Eq a, Eq b, Show a, Conjurable a, Conjurable b)
             => Args -> String -> Spec1 a b -> [Expr] -> IO ()
conjure1With :: Args -> String -> Spec1 a b -> [Expr] -> IO ()
conjure1With Args
args String
nm Spec1 a b
bs  =  Args -> String -> (a -> b) -> [Expr] -> IO ()
forall f. Conjurable f => Args -> String -> f -> [Expr] -> IO ()
conjureWith Args
args{forceTests :: [[Expr]]
forceTests=[[Expr]]
ts} String
nm (Spec1 a b -> a -> b
forall a b. Eq a => [(a, b)] -> a -> b
mkFun1 Spec1 a b
bs)
  where
  ts :: [[Expr]]
ts = [[a -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val a
x] | (a
x,b
_) <- Spec1 a b
bs]


-- | Like 'conjure2' but allows setting options through 'Args'/'args'.
conjure2With :: ( Conjurable a, Eq a, Show a
                , Conjurable b, Eq b, Show b
                , Conjurable c, Eq c
                ) => Args -> String -> Spec2 a b c -> [Expr] -> IO ()
conjure2With :: Args -> String -> Spec2 a b c -> [Expr] -> IO ()
conjure2With Args
args String
nm Spec2 a b c
bs  =  Args -> String -> (a -> b -> c) -> [Expr] -> IO ()
forall f. Conjurable f => Args -> String -> f -> [Expr] -> IO ()
conjureWith Args
args{forceTests :: [[Expr]]
forceTests=[[Expr]]
ts} String
nm (Spec2 a b c -> a -> b -> c
forall a b c. (Eq a, Eq b) => [((a, b), c)] -> a -> b -> c
mkFun2 Spec2 a b c
bs)
  where
  ts :: [[Expr]]
ts = [[a -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val a
x, b -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val b
y] | ((a
x,b
y),c
_) <- Spec2 a b c
bs]


-- | Like 'conjure3' but allows setting options through 'Args'/'args'.
conjure3With :: ( Conjurable a, Eq a, Show a
                , Conjurable b, Eq b, Show b
                , Conjurable c, Eq c, Show c
                , Conjurable d, Eq d
                ) => Args -> String -> Spec3 a b c d -> [Expr] -> IO ()
conjure3With :: Args -> String -> Spec3 a b c d -> [Expr] -> IO ()
conjure3With Args
args String
nm Spec3 a b c d
bs  =  Args -> String -> (a -> b -> c -> d) -> [Expr] -> IO ()
forall f. Conjurable f => Args -> String -> f -> [Expr] -> IO ()
conjureWith Args
args{forceTests :: [[Expr]]
forceTests=[[Expr]]
ts} String
nm (Spec3 a b c d -> a -> b -> c -> d
forall a b c d.
(Eq a, Eq b, Eq c) =>
[((a, b, c), d)] -> a -> b -> c -> d
mkFun3 Spec3 a b c d
bs)
  where
  ts :: [[Expr]]
ts = [[a -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val a
x, b -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val b
y, c -> Expr
forall a. (Typeable a, Show a) => a -> Expr
val c
z] | ((a
x,b
y,c
z),d
_) <- Spec3 a b c d
bs]


mkFun1 :: Eq a => [(a,b)] -> a -> b
mkFun1 :: [(a, b)] -> a -> b
mkFun1 [(a, b)]
bs  =  \a
x -> b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
forall a. HasCallStack => a
undefined (Maybe b -> b) -> Maybe b -> b
forall a b. (a -> b) -> a -> b
$ a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x [(a, b)]
bs


mkFun2 :: (Eq a, Eq b) => [((a,b),c)] -> a -> b -> c
mkFun2 :: [((a, b), c)] -> a -> b -> c
mkFun2 [((a, b), c)]
bs  =  \a
x b
y -> c -> Maybe c -> c
forall a. a -> Maybe a -> a
fromMaybe c
forall a. HasCallStack => a
undefined (Maybe c -> c) -> Maybe c -> c
forall a b. (a -> b) -> a -> b
$ (a, b) -> [((a, b), c)] -> Maybe c
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (a
x,b
y) [((a, b), c)]
bs


mkFun3 :: (Eq a, Eq b, Eq c) => [((a,b,c),d)] -> a -> b -> c -> d
mkFun3 :: [((a, b, c), d)] -> a -> b -> c -> d
mkFun3 [((a, b, c), d)]
bs  =  \a
x b
y c
z -> d -> Maybe d -> d
forall a. a -> Maybe a -> a
fromMaybe d
forall a. HasCallStack => a
undefined (Maybe d -> d) -> Maybe d -> d
forall a b. (a -> b) -> a -> b
$ (a, b, c) -> [((a, b, c), d)] -> Maybe d
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (a
x,b
y,c
z) [((a, b, c), d)]
bs