{-# LANGUAGE UndecidableInstances #-}

module Symantic.Syntaxes.Extras where

import Data.Function qualified as Fun
import Data.Int (Int)
import Debug.Trace (trace)
import Symantic.Semantics.Identity
import Symantic.Semantics.LetInserter
import Symantic.Semantics.Viewer
import Symantic.Semantics.Viewer.Fixity
import Symantic.Syntaxes.Classes (Abstractable (..), Instantiable (..))
import Symantic.Syntaxes.Derive
import Text.Show (show, showString)
import Prelude qualified

-- * Type 'Addable'
class Addable sem where
  add :: sem (Int -> Int -> Int)
  default add ::
    FromDerived Addable sem =>
    sem (Int -> Int -> Int)
  add = liftDerived add
infixl 6 `add`, +
(+) ::
  Instantiable sem =>
  Addable sem =>
  sem Int ->
  sem Int ->
  sem Int
(+) x y = add .@ x .@ y
instance Addable sem => Addable (OpenCode sem)
instance Addable sem => Addable (AnnotatedCode sem)
instance Addable sem => Addable (LetInserter sem)
instance Addable Viewer where
  add = ViewerInfix (infixB SideL 6) "(+)" "+"
instance Addable Identity where
  add = lam (\x -> lam (x Prelude.+))

-- * Type 'Traceable'
class Logable sem where
  log :: Prelude.String -> sem a -> sem a
  default log ::
    FromDerived1 Logable sem =>
    Prelude.String ->
    sem a ->
    sem a
  log msg = liftDerived1 (log msg)
instance Logable sem => Logable (OpenCode sem)
instance Logable sem => Logable (AnnotatedCode sem)
instance Logable sem => Logable (LetInserter sem)
instance Logable Viewer where
  log msg a = Viewer (\_env -> showString "log " Fun.. showString (show msg)) .@ a
instance Logable Identity where
  log msg = Identity Fun.. trace msg Fun.. runIdentity

-- * Type 'Substractable'
class Substractable sem where
  substract :: sem (Int -> Int -> Int)
  default substract ::
    FromDerived Substractable sem =>
    sem (Int -> Int -> Int)
  substract = liftDerived substract
infixl 6 `substract`, -
(-) ::
  Instantiable sem =>
  Substractable sem =>
  sem Int ->
  sem Int ->
  sem Int
(-) x y = substract .@ x .@ y
instance Substractable sem => Substractable (OpenCode sem)
instance Substractable sem => Substractable (AnnotatedCode sem)
instance Substractable sem => Substractable (LetInserter sem)
instance Substractable Viewer where
  substract = ViewerInfix (infixB SideL 6) "(-)" "-"
instance Substractable Identity where
  substract = lam (\x -> lam (x Prelude.-))

-- * Type Multiplicable
class Multiplicable sem where
  multiply :: sem (Int -> Int -> Int)
  default multiply ::
    FromDerived Multiplicable sem =>
    sem (Int -> Int -> Int)
  multiply = liftDerived multiply
infixl 7 `multiply`, *
(*) ::
  Instantiable sem =>
  Multiplicable sem =>
  sem Int ->
  sem Int ->
  sem Int
(*) x y = multiply .@ x .@ y
instance Multiplicable sem => Multiplicable (OpenCode sem)
instance Multiplicable sem => Multiplicable (AnnotatedCode sem)
instance Multiplicable sem => Multiplicable (LetInserter sem)
instance Multiplicable Viewer where
  multiply = ViewerInfix (infixB SideL 7) "(*)" "*"
instance Multiplicable Identity where
  multiply = lam (\x -> lam (x Prelude.*))

-- * Type Divisible
class Divisible i sem where
  divide :: sem (i -> i -> i)
  default divide ::
    FromDerived (Divisible i) sem =>
    sem (i -> i -> i)
  divide = liftDerived divide
infixl 7 `divide`, /
(/) ::
  Instantiable sem =>
  Divisible i sem =>
  sem i ->
  sem i ->
  sem i
(/) x y = divide .@ x .@ y
instance Divisible i sem => Divisible i (OpenCode sem)
instance Divisible i sem => Divisible i (AnnotatedCode sem)
instance Divisible i sem => Divisible i (LetInserter sem)
instance Divisible i Viewer where
  divide = ViewerInfix (infixB SideL 7) "(/)" "/"
instance Prelude.Fractional i => Divisible i Identity where
  divide = lam (\x -> lam (x Prelude./))