experimentinunittesting.elm

import Signal exposing (Address)
import Json.Decode as Json exposing (Decoder, list, int, float, maybe, (:=))
import Html exposing (Html, Attribute, div, ul, li, text, span, input)
import Html.Attributes exposing (style)
import Html.Events exposing (on, targetValue)

-------------------
-- MAIN -----------
-------------------

main = 
  run testSuite
  
  

testSuite = 
  suite "Test Suite"
    [ test_reverse_ints
    , test_maybe_not_null
    , test_vector_x_equal_y 
    ]
    
-------------------
-- EXAMPLE TESTS --
-------------------

-- Testing reverse of ints
-- Successful example : [1]
-- Failing example : [1, 2]
test_reverse_ints = 
  test "All lists of ints are equal to their reverse"
    (list int)
    (List.reverse)
    (identity)

-- Testing maybes
-- Successful example : 3
-- Failing example : null
test_maybe_not_null = 
  test "There is no such value as null, only ints"
    (maybe int)
    (\m -> m /= Nothing)
    (always True)


type alias Vector = { x : Float, y : Float }

vector = 
  Json.object2 Vector
    ("x" := float)
    ("y" := float)
    
   
-- Testing vectors
-- Successful example : { "x" : 2, "y" : 2 }
-- Failing example : { "x" : 2, "y" : 3 }
test_vector_x_equal_y = 
  test "All vectors fall on the line x = y"
    vector
    (\{x,y} -> x)
    (\{x,y} -> y)

--------------------
-- TEST API --------
--------------------

type alias Test =
  { model  : State
  , update : Update Action State
  , view   : View Action State
  }
  
  
test : String -> Decoder a -> (a -> b) -> (a -> b) -> Test
test name decoder actualStatement expectedStatement = 
  { model = 
      Leaf name
        { model = initUnit
        , update = makeUnitUpdate decoder actualStatement expectedStatement
        , view = viewUnit
        }
  , update = update
  , view = view
  }


suite : String -> List Test -> Test
suite name tests = 
  { model = Branch name (List.map .model tests)
  , update = update
  , view = view
  }
  
  
run : Test -> Signal Html
run test = 
  let 
      mailbox = 
        Signal.mailbox Nothing
        
      update maybeAction state = 
        case maybeAction of 
          Nothing ->
            state
            
          Just action ->
            test.update action state
            
      view state = 
        test.view (Signal.forwardTo mailbox.address Just) state
        
  in 
      Signal.map view
        (Signal.foldp update test.model mailbox.signal)


--------------------
-- APP -------------
--------------------

type alias State 
  = Tree Unit

type Action
  = ChildAction (List Int) UnitAction
    
  
update : Update Action State
update action state = 
  case action of
    ChildAction index childAction -> 
      updateNthUnit index childAction state
      
      
       
view : View Action State
view address state = 
  let 
      viewN index unit = 
        let 
            unitAddress = 
              Signal.forwardTo address (ChildAction index) 
        in 
            unit.view unitAddress unit.model 
              
            
            
      viewAll tree = 
        case tree of 
          Leaf name a ->
            li 
              []
              [ span 
                  []
                  [ text name ]
              , a
              ]
            
          Branch name subtrees ->
            li 
              []
              [ span 
                  []
                  [ text name ]
              , ul 
                  []
                  ( List.map viewAll subtrees )
              ]
  in 
      state
      |> indexedMap viewN
      |> viewAll

--------------------
-- UNIT ------------
--------------------

type alias Unit = 
  { model  : UnitState
  , update : Update UnitAction UnitState
  , view   : View UnitAction UnitState
  }


type alias UnitState = 
  { assertion : Maybe Assertion }
  
initUnit : UnitState 
initUnit = 
  { assertion = Nothing }
  
type UnitAction 
  = CheckInput String


updateNthUnit : List Int -> UnitAction -> Tree Unit -> Tree Unit
updateNthUnit index action tree = 
  let 
      updater unit =   
        { unit | model <- unit.update action unit.model }
        
  in 
      updateNth index updater tree
        


makeUnitUpdate : Decoder a -> (a -> b) -> (a -> b) -> Update UnitAction UnitState
makeUnitUpdate decoder actualStatement expectedStatement action _ = 
  case action of 
    CheckInput input -> 
      case Json.decodeString decoder input of 
        Err _ ->
          { assertion = Nothing }
          
        Ok value ->
          { assertion = Just (assert actualStatement expectedStatement value) }


viewUnit : View UnitAction UnitState 
viewUnit address state = 
  let 
      (message, textColor) = 
        case state.assertion of 
          Nothing -> 
            ("Incorrect Input", "black")
            
          Just assertion ->
             if assertion.passed
             then 
               ("Test has passed", "green")
             else
               ("Test has failed", "red")
               
      textStyle = 
        [ ("color", textColor) ]
        
 in 
     div 
       []
       [ input 
           [ on "input" targetValue (CheckInput >> Signal.message address) ]
           []
       , div
           [ style textStyle ]
           [ text message ]
       ]


--------------------
type alias View action state   = Address action -> state -> Html
type alias Update action state = action -> state -> state
--------------------


---------------------
-- ASSERTION --------
---------------------

type alias Assertion =
  { passed : Bool
  , actual : String
  , expected : String
  }



assert : (a -> b) -> (a -> b) -> a -> Assertion
assert actualStatement expectedStatement a = 
  let 
      actual = actualStatement a 
      expected = expectedStatement a 
  in 
      { passed = actual == expected
      , actual = toString actual
      , expected = toString expected
      }
   
---------------------


---------------------
-- TREE -------------
---------------------

type Tree a 
  = Branch String (List (Tree a))
  | Leaf String a
  
indexedMap : (List Int -> a -> b) -> Tree a -> Tree b 
indexedMap f tree = 
  let 
      applyMap list subtree = 
        case subtree of 
          Leaf name a -> 
            Leaf name (f list a)
            
          Branch name subtrees ->
            subtrees
            |> List.indexedMap (\index tree -> applyMap (list ++ [index]) tree) 
            |> Branch name
            
  in 
      applyMap [] tree


updateNth : List Int -> (a -> a) -> Tree a -> Tree a 
updateNth index f tree = 
  indexedMap (\n a -> if n == index then f a else a) tree