tmp.hs

module Main where

import Control.Monad

import Control.Parallel
import Control.Parallel.Strategies

f _ 0 = 0
f x n = (x + (f x (n-1) ) ) ^ 2

-- The base type for all numerical operations
type NumType = Integer

-- Target and available numbers to solve a certain problem
data Problem = Problem NumType [NumType]

-- Results may be valid, in which case they are represented as
-- Val(ues) or invalid, which represnets them as Exc(eption).
data Result a
	= Val { val :: a }
	| Exc { exc :: String }
	deriving (Show)

-- The result monad will continue when it encounters values
-- but pass on every exception it encounters, effectively halting
-- further evaluation.
instance Monad Result where
	return = Val
	(Exc e) >>= _ = (Exc e)
	(Val v) >>= g = g v

-- More speaking constructor for exceptions
throwError :: String -> Result a
throwError = Exc

-- Expressions are either a constant value or two expressions
-- combined using a certain operation
data Expr 
	= Const NumType
	| Binary BinOp Expr Expr

-- The possible operations
data BinOp = Add | Sub | Mul | Div | Mod | Bin1 | Bin2 | Bin3
    deriving (Eq)

-- The visualization of the operations
instance Show BinOp where
	show Add = "+"
	show Sub = "-"
	show Mul = "*"
	show Div = "/"
	show Mod = "%"
	show Bin1 = "<+>"
	show Bin2 = "<->"
	show Bin3 = "<*>"

-- This
safeMinus :: Result NumType -> Result NumType -> Result NumType
safeMinus monA monB =
	do
		a <- monA
		b <- monB
		let result = a - b
		if result <= 0
			then throwError "0 occured"
			else return result

-- Prints operations with matching braces
instance Show Expr where
	show (Const zahl) = show zahl
	show (Binary op exp1 exp2) = "( " ++ show exp1 ++ " ) " ++ show op ++ " ( " ++ show exp2 ++ " )"

eval :: Expr -> Result NumType
eval (Const val) = return val
eval (Binary opCode exp1 exp2) = eval exp1 `op` eval exp2
	where op = case opCode of
		Add -> liftM2 (+)
		Sub -> safeMinus
		Mul -> liftM2 (*)
		Div -> liftM2 div -- custom div that errors required
		Mod -> liftM2 mod -- dito
		Bin1 -> liftM2 $  ((.).(.))(^2)(+)
		Bin2 -> liftM2 $ \ a ->  (^2) . (a-)
		Bin3 -> liftM2 $ \ a b -> (a + b) * (a - b) 

-- Don't call score on invalid results
score :: Expr -> NumType
score (Const val) = val
score (Binary op exp1 exp2) = 
	(score exp1) + (score exp2) + (val $ eval (Binary op exp1 exp2))

incOps =  [Add, Mul, Bin1, Bin2, Bin3]
decOps =  [Sub, Div, Mod]

solve :: [NumType] -> NumType -> [Expr]
solve (h:t) target = solve' h (Const h) t target

solve' :: NumType -> Expr -> [NumType] -> NumType -> [Expr]
solve' acc expr [] _ = []
solve' acc expr (h:t) target
	| gtResult == target = gtExpr : solve' gtResult gtExpr t target
	| lsResult == target = lsExpr : solve' lsResult lsExpr t target
	| gtResult <  target =          solve' gtResult gtExpr t target
	| gtResult >  target =          solve' lsResult lsExpr t target
			
	where 
		-- What if ... we add to the current state?
		gtResult    = acc + h
		gtExpr      = (Binary Add expr (Const h))
		-- What if .. we subtract from the current state?
		lsResult    = acc - h
		lsExpr      = if changeValid
						then (Binary Sub expr (Const h))
						else expr
		-- Would the new change be valid?
		changeValid = lsResult > 0

parseList :: String -> [NumType]
parseList = read 

parseTargetNumber :: String -> NumType
parseTargetNumber = read

main :: IO ()
main = do
	strAvailableNumbers <- getLine
	strTargetNumber <- getLine
	let	numbers = parseList strAvailableNumbers
		target = parseTargetNumber strTargetNumber in
			sequence $ (parMap rseq) (print) $ 
				solve numbers target ++
				solve numbers target 

	return ()