{-# LANGUAGE ViewPatterns, RankNTypes, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, OverlappingInstances  #-}

module Graphics.Implicit.ExtOpenScad.Util.OVal where

import Graphics.Implicit.Definitions
import Graphics.Implicit.ExtOpenScad.Definitions
import qualified Control.Monad as Monad
import Data.Maybe (isJust)

-- | We'd like to be able to turn OVals into a given Haskell type
class OTypeMirror a where
	fromOObj :: OVal -> Maybe a
	toOObj :: a -> OVal

instance OTypeMirror OVal where
	fromOObj a = Just a
	toOObj a = a

instance OTypeMirror ℝ where
	fromOObj (ONum n) = Just n
	fromOObj _ = Nothing
	toOObj n = ONum n

instance OTypeMirror ℕ where
	fromOObj (ONum n) = if n == fromIntegral (floor n) then Just (floor n) else Nothing
	fromOObj _ = Nothing
	toOObj n = ONum $ fromIntegral n

instance OTypeMirror Bool where
	fromOObj (OBool b) = Just b
	fromOObj _ = Nothing
	toOObj b = OBool b

instance OTypeMirror String where
	fromOObj (OString str) = Just str
	fromOObj _ = Nothing
	toOObj str = OString str

instance forall a. (OTypeMirror a) => OTypeMirror (Maybe a) where
	fromOObj a = Just $ fromOObj a
	toOObj (Just a) = toOObj a
	toOObj Nothing  = OUndefined

instance forall a. (OTypeMirror a) => OTypeMirror [a] where
	fromOObj (OList list) = Monad.sequence . map fromOObj $ list
	fromOObj _ = Nothing
	toOObj list = OList $ map toOObj list

instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (a,b) where
	fromOObj (OList ((fromOObj -> Just a):(fromOObj -> Just b):[])) = Just (a,b)
	fromOObj _ = Nothing
	toOObj (a,b) = OList [toOObj a, toOObj b]


instance forall a b c. (OTypeMirror a, OTypeMirror b, OTypeMirror c) => OTypeMirror (a,b,c) where
	fromOObj (OList ((fromOObj -> Just a):(fromOObj -> Just b):(fromOObj -> Just c):[])) = 
		Just (a,b,c)
	fromOObj _ = Nothing
	toOObj (a,b,c) = OList [toOObj a, toOObj b, toOObj c]

instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (a -> b) where
	fromOObj (OFunc f) =  Just $ \input ->
		let
			oInput = toOObj input
			oOutput = f oInput
			output = fromOObj oOutput :: Maybe b
		in case output of
			Just out -> out
			Nothing -> error $ "coercing OVal to a -> b isn't always safe; use a -> Maybe b"
			              ++ " (trace: " ++ show oInput ++ " -> " ++ show oOutput ++ " )"
	fromOObj _ = Nothing
	toOObj f = OFunc $ \oObj -> 
		case fromOObj oObj :: Maybe a of
			Nothing  -> OError ["bad input type"]
			Just obj -> toOObj $ f obj


instance forall a b. (OTypeMirror a, OTypeMirror b) => OTypeMirror (Either a b) where
	fromOObj (fromOObj -> Just (x :: a)) = Just $ Left  x
	fromOObj (fromOObj -> Just (x :: b)) = Just $ Right x
	fromOObj _ = Nothing

	toOObj (Right x) = toOObj x
	toOObj (Left  x) = toOObj x

oTypeStr (OUndefined) = "Undefined"
oTypeStr (OBool   _ ) = "Bool"
oTypeStr (ONum    _ ) = "Number"
oTypeStr (OList   _ ) = "List"
oTypeStr (OString _ ) = "String"
oTypeStr (OFunc   _ ) = "Function"
oTypeStr (OModule _ ) = "Module"
oTypeStr (OError  _ ) = "Error"

getErrors :: OVal -> Maybe String
getErrors (OError er) = Just $ head er
getErrors (OList l)   = Monad.msum $ map getErrors l
getErrors _           = Nothing


type Any = OVal

caseOType = flip ($)

infixr 2 <||>

(<||>) :: forall desiredType out. (OTypeMirror desiredType)
	=> (desiredType -> out) 
	-> (OVal -> out)
	-> (OVal -> out)

(<||>) f g = \input ->
	let
		coerceAttempt = fromOObj input :: Maybe desiredType
	in 
		if isJust coerceAttempt -- ≅ (/= Nothing) but no Eq req
		then f $ (\(Just a) -> a) coerceAttempt
		else g input


divideObjs children = 
	(map fromOObj2 . filter isOObj2 $ children,
	 map fromOObj3 . filter isOObj3 $ children,
	 filter (not . isOObj)          $ children)
		where
			isOObj2 (OObj2 _) = True
			isOObj2    _      = False
			isOObj3 (OObj3 _) = True
			isOObj3    _      = False
			isOObj  (OObj2 _) = True
			isOObj  (OObj3 _) = True
			isOObj     _      = False
			fromOObj2 (OObj2 x) = x
			fromOObj3 (OObj3 x) = x