content: module Main where
  
  import Data.Monoid ((<>))
  import Data.Text (Text)
  import qualified Data.Text as Text
  
  import Codec.Beam.Instructions
  import qualified Codec.Beam as Beam
  import qualified Eunit
  
  
  main :: IO ()
  main =
    Eunit.run
      [ Eunit.test "loads_empty"
          [ Beam.insertModuleInfo ]
          [ "?assertMatch({module, loads_empty}, code:load_file(loads_empty))"
          , "?assertEqual(erlang:get_module_info(loads_empty), loads_empty:module_info())"
          , "?assertEqual(erlang:get_module_info(loads_empty, attributes), loads_empty:module_info(attributes))"
          ]
          []
  
      -- From beam_asm: https://git.io/vHTBY
      , withConstant "number_five" id (5 :: Int)
      , withConstant "number_one_thousand" id (5 :: Int)
      , withConstant "number_two_thousand_forty_seven" id (2047 :: Int)
      , withConstant "number_two_thousand_forty_eight" id (2048 :: Int)
      , withConstant "number_negative_one" id (-1 :: Int)
      , withConstant "number_large_negative" id (-4294967295 :: Int)
      , withConstant "number_large_positive" id (4294967295 :: Int)
      , withConstant "number_very_large_positive" id (429496729501 :: Int)
  
      -- Atom table encodings
      , withConstant "arbitrary_atom" id ("hello" :: Text)
      , withConstant "module_name_atom" id ("module_name_atom" :: Text)
      , withConstant_ "constant_nil" Beam.Nil "[]"
  
      -- Comparisons
      , Eunit.test "is_equal"
          [ Beam.export "test" 2 ]
          [ "?assertNot(is_equal:test(2, 3))"
          , "?assertNot(is_equal:test(2.0, 3))"
          , "?assert(is_equal:test(2.0, 2))"
          , "?assert(is_equal:test(2.0, 2.0))"
          ]
          $ withCmp is_eq
      , Eunit.test "is_not_equal"
          [ Beam.export "test" 2 ]
          [ "?assert(is_not_equal:test(2, 3))"
          , "?assert(is_not_equal:test(2.0, 3))"
          , "?assertNot(is_not_equal:test(2.0, 2))"
          , "?assertNot(is_not_equal:test(2.0, 2.0))"
          ]
          $ withCmp is_ne
      , Eunit.test "is_exactly_equal"
          [ Beam.export "test" 2 ]
          [ "?assertNot(is_exactly_equal:test(2, 3))"
          , "?assertNot(is_exactly_equal:test(2.0, 3))"
          , "?assertNot(is_exactly_equal:test(2.0, 2))"
          , "?assert(is_exactly_equal:test(2.0, 2.0))"
          ]
          $ withCmp is_eq_exact
      , Eunit.test "is_not_exactly_equal"
          [ Beam.export "test" 2 ]
          [ "?assert(is_not_exactly_equal:test(2, 3))"
          , "?assert(is_not_exactly_equal:test(2.0, 3))"
          , "?assert(is_not_exactly_equal:test(2.0, 2))"
          , "?assertNot(is_not_exactly_equal:test(2.0, 2.0))"
          ]
          $ withCmp is_ne_exact
      , Eunit.test "is_less_than"
          [ Beam.export "test" 2 ]
          [ "?assert(is_less_than:test(5, 6))"
          , "?assertNot(is_less_than:test(6, 5))"
          , "?assertNot(is_less_than:test(5.0, 5))"
          , "?assertNot(is_less_than:test(6.0, 5.0))"
          ]
          $ withCmp is_lt
      , Eunit.test "is_greater_than_or_equal"
          [ Beam.export "test" 2 ]
          [ "?assertNot(is_greater_than_or_equal:test(5, 6))"
          , "?assert(is_greater_than_or_equal:test(6, 5))"
          , "?assert(is_greater_than_or_equal:test(5.0, 5))"
          , "?assert(is_greater_than_or_equal:test(6.0, 5.0))"
          ]
          $ withCmp is_ge
  
      -- Literal table encodings
      , withConstant_ "atom" (Beam.Atom "hiya") "hiya"
      , withConstant_ "float" (Beam.Float 3.1415) "3.1415"
      , withConstant_ "bitstring" (Beam.Binary "teapot") "<<\"teapot\">>"
      , withConstant_ "empty_tuple" (Beam.Tuple []) "{}"
      , withConstant_ "small_tuple" (Beam.Tuple [Beam.Integer 1]) "{1}"
      , withConstant_ "empty_list" (Beam.List []) "[]"
      , withConstant_ "small_list" (Beam.List [Beam.Integer 4, Beam.Integer 5]) "[4, 5]"
      , withConstant_ "empty_map" (Beam.Map []) "#{}"
      , withConstant_ "small_map" (Beam.Map [(Beam.Atom "a", Beam.Integer 1), (Beam.Atom "b", Beam.Integer 2)]) "#{a=>1,b=>2}"
  
      , Eunit.test "large_tuple"
          [ Beam.export "test" 0 ]
          [ "?assertEqual(300, tuple_size(large_tuple:test()))"
          , "?assertEqual(300, element(300, large_tuple:test()))"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , move (Beam.Tuple (map Beam.Integer [1..300])) (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "multiple_literals"
          [ Beam.export "test" 0 ]
          [ "?assert(multiple_literals:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , move (Beam.Atom "dummy") (Beam.X 0)
          , move (Beam.Atom "true") (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "call_into_identity"
          [ Beam.export "test" 0 ]
          [ "?assertEqual(1023, call_into_identity:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , move (Beam.Integer 1023) (Beam.X 0)
          , call_only 1 (Beam.Label 4)
          , return'
          , label (Beam.Label 3)
          , func_info "identity" 1
          , label (Beam.Label 4)
          , return'
          ]
  
      -- Type checks
      , Eunit.test "is_nil"
          [ Beam.export "test" 1 ]
          [ "?assert(is_nil:test([]))"
          , "?assertNot(is_nil:test(23))"
          , "?assertNot(is_nil:test([23]))"
          ]
          $ withType is_nil
      , Eunit.test "is_list"
          [ Beam.export "test" 1 ]
          [ "?assert(is_list:test([]))"
          , "?assertNot(is_list:test(23))"
          , "?assert(is_list:test([23]))"
          ]
          $ withType is_list
      , Eunit.test "is_nonempty_list"
          [ Beam.export "test" 1 ]
          [ "?assertNot(is_nonempty_list:test([]))"
          , "?assertNot(is_nonempty_list:test(23))"
          , "?assert(is_nonempty_list:test([23]))"
          ]
          $ withType is_nonempty_list
      , Eunit.test "is_map"
          [ Beam.export "test" 1 ]
          [ "?assert(is_map:test(#{}))"
          , "?assertNot(is_map:test(23))"
          , "?assert(is_map:test(#{a=>23}))"
          ]
          $ withType is_map
  
      -- Based on https://happi.github.io/theBeamBook/#x_and_y_regs_in_memory
      , Eunit.test "allocate_for_call_fun"
          [ Beam.export "apply2" 3 ]
          [ "_add = fun 'erlang':'+'/2"
          , "?assertEqual(4, allocate_for_call_fun:apply2(2, 2, _add))"
          ]
          [ label (Beam.Label 1)
          , func_info "apply2" 3
          , label (Beam.Label 2)
          , allocate 2 3
          , move (Beam.X 2) (Beam.Y 1)
          , move (Beam.X 1) (Beam.Y 0)
          , call 1 (Beam.Label 4)
          , move (Beam.X 0) (Beam.X 1)
          , move (Beam.Y 0) (Beam.X 0)
          , move (Beam.X 1) (Beam.Y 0)
          , call 1 (Beam.Label 4)
          , move (Beam.Y 1) (Beam.X 2)
          , move (Beam.X 0) (Beam.X 1)
          , move (Beam.Y 0) (Beam.X 0)
          , call_fun 2
          , deallocate 2
          , return'
          , label (Beam.Label 3)
          , func_info "identity" 1
          , label (Beam.Label 4)
          , return'
          ]
  
      , Eunit.test "external_fun"
          [ Beam.export "test" 0 ]
          [ "?assertEqual(3, (external_fun:test())(1, 2))" ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , move (Beam.ExternalFun (Beam.Import "erlang" "+" 2)) (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "get_tuple_element"
          [ Beam.export "first" 1
          , Beam.export "second" 1
          ]
          [ "?assertEqual(2, get_tuple_element:first({2}))"
          , "?assertEqual(hi, get_tuple_element:second({oh, hi, there}))"
          ]
          [ label (Beam.Label 1)
          , func_info "first" 1
          , label (Beam.Label 2)
          , get_tuple_element (Beam.X 0) 0 (Beam.X 0)
          , return'
          , label (Beam.Label 3)
          , func_info "second" 1
          , label (Beam.Label 4)
          , get_tuple_element (Beam.X 0) 1 (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "set_tuple_element"
          [ Beam.export "make" 1 ]
          [ "?assertEqual({dream, work}, set_tuple_element:make({team, work}))"
          ]
          [ label (Beam.Label 1)
          , func_info "make" 1
          , label (Beam.Label 2)
          , set_tuple_element ("dream" :: Text) (Beam.X 0) 0
          , return'
          ]
  
      , Eunit.test "put_list"
          [ Beam.export "test" 0 ]
          [ "?assertEqual([one, 2], put_list:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , put_list (Beam.Integer 2) Beam.Nil (Beam.X 0)
          , put_list ("one" :: Text) (Beam.X 0) (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "make_a_tuple"
          [ Beam.export "test" 0 ]
          [ "?assertEqual({one, 2}, make_a_tuple:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , put_tuple (2 :: Int) (Beam.X 0)
          , put ("one" :: Text)
          , put (2 :: Int)
          , return'
          ]
  
      , Eunit.test "make_a_map"
          [ Beam.export "test" 0 ]
          [ "?assertEqual(#{a=>1, 2=>b}, make_a_map:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , put_map_assoc (Beam.Label 0) (Beam.Map []) (Beam.X 0)
              [ (Beam.toSource (Beam.Atom "a"), Beam.toSource (1 :: Int))
              , (Beam.toSource (2 :: Int), Beam.toSource (Beam.Atom "b"))
              ]
          , return'
          ]
  
      , Eunit.test "get_from_map"
          [ Beam.export "test" 2 ]
          [ "?assertEqual(5, get_from_map:test(#{a=>5}, a))"
          , "?assertEqual(error, get_from_map:test(#{}, a))"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 2
          , label (Beam.Label 2)
          , get_map_elements (Beam.Label 3) (Beam.X 0)
              [ (Beam.toSource (Beam.X 1), Beam.toRegister (Beam.X 0))
              ]
          , return'
          , label (Beam.Label 3)
          , move ("error" :: Text) (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "get_da_list"
          [ Beam.export "second" 1 ]
          [ "?assertEqual(2, get_da_list:second([1,2,3]))"
          ]
          [ label (Beam.Label 1)
          , func_info "second" 1
          , label (Beam.Label 2)
          , get_list (Beam.X 0) (Beam.X 1) (Beam.X 0)
          , get_list (Beam.X 0) (Beam.X 0) (Beam.X 1)
          , return'
          ]
  
      , Eunit.test "jumping_around"
          [ Beam.export "test" 0 ]
          [ "?assertEqual(yay, jumping_around:test())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 0
          , label (Beam.Label 2)
          , jump (Beam.Label 4)
          , label (Beam.Label 3)
          , move ("yay" :: Text) (Beam.X 0)
          , return'
          , label (Beam.Label 4)
          , jump (Beam.Label 3)
          ]
  
      , Eunit.test "simple_lambda"
          [ Beam.export "test" 1 ]
          [ "?assertEqual(to_capture, (simple_lambda:test(to_capture))())"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 1
          , label (Beam.Label 2)
          , make_fun2 (Beam.Lambda "lambda_function" 0 (Beam.Label 4) 1)
          , return'
          , label (Beam.Label 3)
          , func_info "backing_function" 1
          , label (Beam.Label 4)
          , return'
          ]
  
      , Eunit.test "external_call"
          [ Beam.export "test" 2 ]
          [ "?assertEqual(3, external_call:test(1, 2))"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 2
          , label (Beam.Label 2)
          , call_ext_only (Beam.Import "erlang" "+" 2)
          , return'
          ]
  
      , Eunit.test "float_math"
          [ Beam.export "sum" 2 ]
          [ "?assertEqual(5.0, float_math:sum(2, 3.0))"
          ]
          [ label (Beam.Label 1)
          , func_info "sum" 2
          , label (Beam.Label 2)
          , fconv (Beam.X 0) (Beam.F 0)
          , fmove (Beam.X 1) (Beam.F 1)
          , fclearerror
          , fadd (Beam.F 0) (Beam.F 1) (Beam.F 0)
          , fmove (Beam.F 0) (Beam.X 0)
          , return'
          ]
  
      , Eunit.test "destinations"
          [ Beam.export "test" 1 ]
          [ "?assertEqual(four, destinations:test(4))"
          , "?assertEqual(five, destinations:test(5))"
          , "?assertEqual(neither, destinations:test(6))"
          ]
          [ label (Beam.Label 1)
          , func_info "test" 1
          , label (Beam.Label 2)
          , select_val (Beam.X 0) (Beam.Label 3)
              [ (Beam.Label 4, Beam.toSource (4 :: Int))
              , (Beam.Label 5, Beam.toSource (5 :: Int))
              ]
          , label (Beam.Label 3)
          , move ("neither" :: Text) (Beam.X 0)
          , return'
          , label (Beam.Label 4)
          , move ("four" :: Text) (Beam.X 0)
          , return'
          , label (Beam.Label 5)
          , move ("five" :: Text) (Beam.X 0)
          , return'
          ]
      ]
  
  
  
  -- HELPERS
  -- Having these in one spot makes it easier to see the pain-points in the API.
  -- I imagine that some of these will eventually live in a utility module within src/.
  
  
  withConstant_ :: Beam.IsSource s => String -> s -> String -> Eunit.Test
  withConstant_ name term =
    withConstant name (const term)
  
  
  withConstant :: (Erlang a, Beam.IsSource s) => String -> (a -> s) -> a -> Eunit.Test
  withConstant name toSource value =
    Eunit.test name
      [ Beam.export "check" 0 ]
      [ "?assertEqual(" <> erlang value <> ", " <> name <> ":check())"
      ]
      [ label (Beam.Label 1)
      , func_info "check" 0
      , label (Beam.Label 2)
      , move (toSource value) (Beam.X 0)
      , return'
      ]
  
  withCmp :: (Beam.Label -> Beam.X -> Beam.X -> Beam.Op) -> [Beam.Op]
  withCmp toOp =
    jumpFunction 2 $ \i -> toOp i (Beam.X 0) (Beam.X 1)
  
  
  withType :: (Beam.Label -> Beam.X -> Beam.Op) -> [Beam.Op]
  withType toOp =
    jumpFunction 1 $ \i -> toOp i (Beam.X 0)
  
  
  jumpFunction :: Int -> (Beam.Label -> Beam.Op) -> [Beam.Op]
  jumpFunction args decision =
    [ label (Beam.Label 1)
    , func_info "test" args
    , label (Beam.Label 2)
    , decision (Beam.Label 3)
    , move ("true" :: Text) (Beam.X 0)
    , return'
    , label (Beam.Label 3)
    , move ("false" :: Text) (Beam.X 0)
    , return'
    ]
  
  
  
  -- PRINT ERLANG LITERALS
  
  
  class Erlang a where
    erlang :: a -> String
  
  instance Erlang a => Erlang [a] where
    erlang = mconcat . map erlang
  
  instance Erlang Text where
    erlang = Text.unpack
  
  instance Erlang Int where
    erlang = erlang . show
  
  instance Erlang Char where
    erlang x = [x]
  