{-# LANGUAGE OverloadedStrings #-}

module Test.Nand2Tetris.VM
  (
    spec
  ) where

import           Test.Hspec       (Spec, describe, it, shouldBe)

import           Nand2Tetris.Hack (HackInstruction (..), Imm (..), Jump (..),
                                   Reg (..), Source (..))
import           Nand2Tetris.VM   (AccessType (ACPop, ACPush),
                                   AnnotatedAsmLine (..),
                                   ArithmeticCmd (ACAdd, ACAnd, ACEq, ACGt, ACLt, ACNeg, ACNot, ACOr, ACSub),
                                   Segment (SArgument, SConstant, SLocal, SPointer, SStatic, STemp, SThat, SThis),
                                   VMInstruction (VMArithmetic, VMMemAccess),
                                   compileInstruction, parseInstruction)
import           Text.Megaparsec  (runParser)


spec :: Spec
spec = do
  describe "parseInstruction" parseInstructionSpec
  describe "compileInstruction" compileInstructionSpec

parseInstructionSpec :: Spec
parseInstructionSpec = do
    it "Parses instruction: push argument 42" $
      doParse "push argument 42" `shouldBe` Right (VMMemAccess ACPush (SArgument 42))

    it "Parses instruction: pop argument 42" $
      doParse "pop argument 42" `shouldBe` Right (VMMemAccess ACPop (SArgument 42))

    it "Parses instruction: push local 42" $
      doParse "push local 42" `shouldBe` Right (VMMemAccess ACPush (SLocal 42))

    it "Parses instruction: push this 42" $
      doParse "push this 42" `shouldBe` Right (VMMemAccess ACPush (SThis 42))

    it "Parses instruction: push that 42" $
      doParse "push that 42" `shouldBe` Right (VMMemAccess ACPush (SThat 42))

    it "Parses instruction: push constant 42" $
      doParse "push constant 42" `shouldBe` Right (VMMemAccess ACPush (SConstant 42))

    it "Parses instruction: push static Foo.1" $
      doParse "push static Foo.1" `shouldBe` Right (VMMemAccess ACPush (SStatic "Foo.1"))

    it "Parses instruction: push pointer 42" $
      doParse "push pointer 42" `shouldBe` Right (VMMemAccess ACPush (SPointer 42))

    it "Parses instruction: push temp 42" $
      doParse "push temp 42" `shouldBe` Right (VMMemAccess ACPush (STemp 42))

    it "Parses instruction: push temp 11" $
      doParse "push temp 11" `shouldBe` Right (VMMemAccess ACPush (STemp 11))

    it "Parses instruction: add" $
      doParse "add" `shouldBe` Right (VMArithmetic ACAdd)

    it "Parses instruction: sub" $
      doParse "sub" `shouldBe` Right (VMArithmetic ACSub)

    it "Parses instruction: neg" $
      doParse "neg" `shouldBe` Right (VMArithmetic ACNeg)

    it "Parses instruction: eq" $
      doParse "eq" `shouldBe` Right (VMArithmetic ACEq)

    it "Parses instruction: gt" $
      doParse "gt" `shouldBe` Right (VMArithmetic ACGt)

    it "Parses instruction: lt" $
      doParse "lt" `shouldBe` Right (VMArithmetic ACLt)

    it "Parses instruction: and" $
      doParse "and" `shouldBe` Right (VMArithmetic ACAnd)

    it "Parses instruction: or" $
      doParse "or" `shouldBe` Right (VMArithmetic ACOr)

    it "Parses instruction: not" $
      doParse "not" `shouldBe` Right (VMArithmetic ACNot)

  where
    doParse = runParser parseInstruction ""

compileInstructionSpec :: Spec
compileInstructionSpec = do
  it "Compiles push argument 42" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SArgument 42))
    head compiled `shouldBe` (Comment "push argument 42")
    tail compiled `shouldBe` pushValue "ARG" 42

  it "Compiles push local 42" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SLocal 42))
    head compiled `shouldBe` (Comment "push local 42")
    tail compiled `shouldBe` pushValue "LCL" 42

  it "Compiles push this 41" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SThis 41))
    head compiled `shouldBe` (Comment "push this 41")
    tail compiled `shouldBe` pushValue "THIS" 41

  it "Compiles push that 41" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SThat 41))
    head compiled `shouldBe` (Comment "push that 41")
    tail compiled `shouldBe` pushValue "THAT" 41

  it "Compiles push constant 17" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SConstant 17))
    head compiled `shouldBe` (Comment "push constant 17")
    tail compiled `shouldBe` [
        Code (A (Imm 17)),
        Code (C [RegD] (SReg RegA) JNone),
        Code (A (Label "SP")),
        Code (C [RegA] (SReg RegM) JNone),
        Code (C [RegM] (SReg RegD) JNone),
        Code (C [RegD] (SRegPlus1 RegA) JNone),
        Code (A (Label "SP")),
        Code (C [RegM] (SReg RegD) JNone) ]

  it "Compiles push static Foo.1" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SStatic "Foo.1"))
    head compiled `shouldBe` (Comment "push static Foo.1")
    tail compiled `shouldBe` pushLabel "Foo.1"

  it "Compiles push pointer 0" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SPointer 0))
    head compiled `shouldBe` (Comment "push pointer 0")
    tail compiled `shouldBe` pushLabel "THIS"

  it "Compiles push pointer 1" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (SPointer 1))
    head compiled `shouldBe` (Comment "push pointer 1")
    tail compiled `shouldBe` pushLabel "THAT"

  it "Compiles push temp 2" $ do
    let compiled = compileInstruction (VMMemAccess ACPush (STemp 2))
    head compiled `shouldBe` (Comment "push temp 2")
    tail compiled `shouldBe` pushRam (5 + 2)

    where
      pushRam offset = [ Code (A (Imm offset)),
                          Code (C [RegD] (SReg RegM) JNone),
                          Code (A (Label "SP")),
                          Code (C [RegA] (SReg RegM) JNone),
                          Code (C [RegM] (SReg RegD) JNone),
                          Code (C [RegD] (SRegPlus1 RegA) JNone),
                          Code (A (Label "SP")),
                          Code (C [RegM] (SReg RegD) JNone) ]
      pushLabel label = [ Code (A (Label label)),
                          Code (C [RegD] (SReg RegM) JNone),
                          Code (A (Label "SP")),
                          Code (C [RegA] (SReg RegM) JNone),
                          Code (C [RegM] (SReg RegD) JNone),
                          Code (C [RegD] (SRegPlus1 RegA) JNone),
                          Code (A (Label "SP")),
                          Code (C [RegM] (SReg RegD) JNone) ]

      pushValue reg value = [ Code (A (Imm value)),
                              Code (C [RegD] (SReg RegA) JNone),
                              Code (A (Label reg)),
                              Code (C [RegA] (SReg RegM) JNone),
                              Code (C [RegA] SDPlusA JNone),
                              Code (C [RegD] (SReg RegM) JNone),
                              Code (A (Label "SP")),
                              Code (C [RegA] (SReg RegM) JNone),
                              Code (C [RegM] (SReg RegD) JNone),
                              Code (C [RegD] (SRegPlus1 RegA) JNone),
                              Code (A (Label "SP")),
                              Code (C [RegM] (SReg RegD) JNone) ]