{-# LANGUAGE DeriveDataTypeable #-}
module Main where

import Control.Monad
import Control.Monad.Error
import Control.Monad.Writer
import Data.Char
import Data.Data
import Data.Generics
import System.Directory
import System.Exit
import Test.HUnit
import Text.Hastache
import Text.Hastache.Context
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LZ
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

resCorrectness = "result correctness"

-- Hastache comments
commentsTest = do
    res <- hastacheStr defaultConfig (encodeStr template) undefined
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \hello {{! comment #1}} world! \n\
        \hello {{! comment #2 \n\
        \multiline\n\
        \}} world! \n\
        \"
    testRes  = "\
        \hello  world! \n\
        \hello  world! \n\
        \"

-- Variables
variablesTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \   Char:               [ {{Char}} ]            \n\
        \   Double:             [ {{Double}} ]          \n\
        \   Int:                [ {{Int}} ]             \n\
        \   ByteString:         [ {{ByteString}} ]      \n\
        \   Text:               [ {{Text}} ]            \n\
        \   String:             [ {{String}} ]          \n\
        \   HtmlString:         [ {{HtmlString}} ]      \n\
        \   HtmlStringUnEsc:    [ {{{HtmlString}}} ]    \n\
        \   HtmlStringUnEsc2:   [ {{&HtmlString}} ]     \n\
        \"
    context "Char" = MuVariable 'Й'
    context "Double" = MuVariable (123.45 :: Double)
    context "Int" = MuVariable (5 :: Int)
    context "ByteString" = MuVariable (encodeStr "hello - привет")
    context "Text" = MuVariable (T.pack "hello - привет")
    context "String" = MuVariable "hello - привет"
    context "HtmlString" = MuVariable "<p>text (\\)</p>"

    testRes  = "\
        \   Char:               [ Й ]            \n\
        \   Double:             [ 123.45 ]          \n\
        \   Int:                [ 5 ]             \n\
        \   ByteString:         [ hello - привет ]      \n\
        \   Text:               [ hello - привет ]            \n\
        \   String:             [ hello - привет ]          \n\
        \   HtmlString:         [ &lt;p&gt;text (&#92;)&lt;/p&gt; ]      \n\
        \   HtmlStringUnEsc:    [ <p>text (\\)</p> ]    \n\
        \   HtmlStringUnEsc2:   [ <p>text (\\)</p> ]     \n\
        \"

-- Show/hide sections
showHideSectionsTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \no context : {{^noCtx}}Should render{{/noCtx}}\n\
        \text 1\n\
        \{{#emptyList}}\n\
        \   some text\n\
        \{{/emptyList}}\n\
        \text 2\n\
        \{{^emptyList}}\n\
        \   empty list. {{someval}}\n\
        \{{/emptyList}}\n\
        \inline [{{#emptyList}}txt{{/emptyList}}]\n\
        \{{#emptyString}}no {{someval}}{{/emptyString}}\
        \{{^emptyString}}yes {{someval}}{{/emptyString}}\n\
        \{{#emptyInt}}no {{emptyInt}}{{/emptyInt}}\
        \{{^emptyInt}}yes {{emptyInt}}{{/emptyInt}}\n\
        \{{#emptyDouble}}no {{emptyDouble}}{{/emptyDouble}}\
        \{{^emptyDouble}}yes {{emptyDouble}}{{/emptyDouble}}\n\
        \{{#nonEmptyString}}yes {{nonEmptyString}}{{/nonEmptyString}}\
        \{{^nonEmptyString}}no{{/nonEmptyString}}\n\
        \{{#nonEmptyInt}}yes {{nonEmptyInt}}{{/nonEmptyInt}}\
        \{{^nonEmptyInt}}no{{/nonEmptyInt}}\n\
        \{{#nonEmptyDouble}}yes {{nonEmptyDouble}}{{/nonEmptyDouble}}\
        \{{^nonEmptyDouble}}no{{/nonEmptyDouble}}\n\
        \"
    context "noCtx" = MuNothing
    context "emptyList" = MuList []
    context "someval" = MuVariable (5 :: Int)
    context "emptyString" = MuVariable ""
    context "emptyInt" = MuVariable (0 :: Int)
    context "emptyDouble" = MuVariable (0 :: Double)
    context "nonEmptyString" = MuVariable "some"
    context "nonEmptyInt" = MuVariable (1 :: Int)
    context "nonEmptyDouble" = MuVariable (1 :: Double)

    testRes = "\
        \no context : Should render\n\
        \text 1\n\
        \text 2\n\
        \   empty list. 5\n\
        \inline []\n\
        \yes 5\n\
        \yes 0\n\
        \yes 0.0\n\
        \yes some\n\
        \yes 1\n\
        \yes 1.0\n\
        \"

-- Render list
listSectionTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{#section}}\n\
        \ * {{name}} \n\
        \{{/section}}\n\
        \text 2\n\
        \inline {{#section}}[{{name}}]{{/section}}\n\
        \"
    context "section" = MuList $ map nameCtx ["Neo", "Morpheus", "Trinity"]
    nameCtx name = mkStrContext (\"name" -> MuVariable name)

    testRes = "\
        \text 1\n\
        \ * Neo \n\
        \ * Morpheus \n\
        \ * Trinity \n\
        \text 2\n\
        \inline [Neo][Morpheus][Trinity]\n\
        \"

-- Show/hide block according to boolean variable
boolSectionTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{#bool_true}}\n\
        \   true: {{someval}} \n\
        \{{/bool_true}}\n\
        \{{^bool_true}}\n\
        \   true inv: {{someval}} \n\
        \{{/bool_true}}\n\
        \{{#bool_false}}\n\
        \   false: {{someval}} \n\
        \{{/bool_false}}\n\
        \{{^bool_false}}\n\
        \   false inv: {{someval}} \n\
        \{{/bool_false}}\n\
        \text 2\n\
        \"
    context "bool_true" = MuBool True
    context "bool_false" = MuBool False
    context "someval" = MuVariable "val"

    testRes = "\
        \text 1\n\
        \   true: val \n\
        \   false inv: val \n\
        \text 2\n\
        \"

-- Transorm section
lambdaSectionTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{#function}}Hello{{/function}}\n\
        \text 2\n\
        \"
    context "function" = MuLambda T.reverse

    testRes = "\
        \text 1\n\
        \olleH\n\
        \text 2\n\
        \"

-- Transform section with monadic function
lambdaMSectionTest = do
    (res, writerState) <- runWriterT monadicFunction
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    assertEqualStr "monad state correctness" (decodeStr writerState)
        testMonad
    where
    monadicFunction = hastacheStr defaultConfig (encodeStr template)
            (mkStrContext context)
    template = "\
        \[{{#mf}}abc{{/mf}}]\n\
        \[{{#mf}}def{{/mf}}]\n\
        \"
    context "mf" = MuLambdaM $ \i -> do
        tell i
        return $ T.reverse i
    testRes = "\
        \[cba]\n\
        \[fed]\n\
        \"
    testMonad = "abcdef"

-- Monadic context function
monadicContextTest = do
    r <- runErrorT $ hastacheStr defaultConfig (encodeStr template)
        (mkStrContextM context)
    let { res = case r of
        Left err  -> "error: " ++ err
        Right res -> decodeStrLT res }
    assertEqualStr resCorrectness res testRes
    where
    template = "Hello, {{name}}! You have {{unread}} unread messages. {{some}}"
    context "name"   = return $ MuVariable "Haskell"
    context "unread" = return $ MuVariable (100 :: Int)
    context var      = throwError $ "{{" ++ var  ++ "}} not found!"
    testRes = "error: {{some}} not found!"

-- Change delimiters
setDelimiterTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{someVar}}\n\
        \{{=<% %>=}}\n\
        \<%someVar%>\n\
        \<%={{ }}=%>\n\
        \{{someVar}}\n\
        \text 2\n\
        \"
    context "someVar" = MuVariable "some value"

    testRes = "\
        \text 1\n\
        \some value\n\
        \some value\n\
        \some value\n\
        \text 2\n\
        \"

-- Render external (partial) template file
partialsTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{> partFile}}\n\
        \text 2\n\
        \"
    context "name" = MuVariable "Neo"

    testRes = "\
        \text 1\n\
        \Hi, Neo!\n\
        \text 2\n\
        \"

data InternalData = InternalData {
    intDataField1   :: String,
    intDataField2   :: Int
    }
    deriving (Data, Typeable)

data SomeData = SomeData {
    someDataField1      :: String,
    someDataInternal    :: InternalData,
    someDataList        :: [Int],
    someDataObjList     :: [InternalData],
    someMuLambdaBS      :: BS.ByteString -> BS.ByteString,
    someMuLambdaS       :: String -> String,
    someMuLambdaMBS     :: BS.ByteString -> IO BS.ByteString,
    someMuLambdaMS      :: String -> IO String,
    someEitherValue     :: Either String Int
    }
    deriving (Data, Typeable)

-- Make hastache context from Data.Data deriving type
genericContextTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkGenericContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \text 1\n\
        \{{someDataField1}} {{someDataInternal.intDataField1}} \n\
        \{{someDataInternal.intDataField2}} \n\
        \{{#someDataInternal}}\n\
        \* {{intDataField1}} {{intDataField2}} \n\
        \{{/someDataInternal}}\n\
        \Simple list:\n\
        \{{#someDataList}}\n\
        \* {{.}} \n\
        \{{/someDataList}}\n\
        \List item by index: {{someDataList.1}} \n\
        \Obj list:\n\
        \{{#someDataObjList}}\n\
        \* {{intDataField1}} : {{intDataField2}} \n\
        \{{/someDataObjList}}\n\
        \{{#someMuLambdaBS}}reverse{{/someMuLambdaBS}}\n\
        \{{#someMuLambdaS}}upper{{/someMuLambdaS}}\n\
        \{{#someMuLambdaMBS}}reverse in IO lambda{{/someMuLambdaMBS}}\n\
        \{{#someMuLambdaMS}}upper in IO lambda{{/someMuLambdaMS}}\n\
        \{{someEitherValue}}\n\
        \text 2\n\
        \"
    context = SomeData {
        someDataField1 = "aaa",
        someDataInternal = InternalData {
            intDataField1 = "zzz", intDataField2 = 100 },
        someDataList = [1,2,3],
        someDataObjList = [InternalData "a" 1, InternalData "b" 2,
            InternalData "c" 3],
        someMuLambdaBS = BS.reverse,
        someMuLambdaS = map toUpper,
        someMuLambdaMBS = return . BS.reverse,
        someMuLambdaMS = return . map toUpper,
        someEitherValue = Right 123
        }

    testRes = "\
        \text 1\n\
        \aaa zzz \n\
        \100 \n\
        \* zzz 100 \n\
        \Simple list:\n\
        \* 1 \n\
        \* 2 \n\
        \* 3 \n\
        \List item by index: 2 \n\
        \Obj list:\n\
        \* a : 1 \n\
        \* b : 2 \n\
        \* c : 3 \n\
        \esrever\n\
        \UPPER\n\
        \adbmal OI ni esrever\n\
        \UPPER IN IO LAMBDA\n\
        \123\n\
        \text 2\n\
        \"

-- Up-level context from nested block
nestedContextTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \{{top}}\n\
        \{{#section}}\n\
        \ * {{val}}. {{top}}\n\
        \{{/section}}\n\
        \"
    context "section" = MuList $ map elemCtx ["elem 1", "elem 2"]
    context "top" = MuVariable "top"
    elemCtx vl = mkStrContext (\v -> case v of
        "val" -> MuVariable vl
        _ -> MuNothing
        )

    testRes = "\
        \top\n\
        \ * elem 1. top\n\
        \ * elem 2. top\n\
        \"

-- Up-level context from nested block (Generic version)
data TopData = TopData {
    topDataTop          :: String,
    topDataItems        :: [NestedData]
    }
    deriving (Data, Typeable)

data NestedData = NestedData {
    nestedDataNested    :: String
    }
    deriving (Data, Typeable)

nestedGenericContextTest = do
    res <- hastacheStr defaultConfig (encodeStr template) context
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \Top variable : {{topDataTop}}\n\
        \{{#topDataItems}}\n\
        \-- Nested section\n\
        \Top variable : {{topDataTop}}\n\
        \Nested variable : {{nestedDataNested}}\n\
        \{{/topDataItems}}\n\
        \"
    context = mkGenericContext $ TopData {
        topDataTop = "TOP",
        topDataItems = [
            NestedData "NESTED_ONE",
            NestedData "NESTED_TWO"]
    }
    testRes = "\
        \Top variable : TOP\n\
        \-- Nested section\n\
        \Top variable : TOP\n\
        \Nested variable : NESTED_ONE\n\
        \-- Nested section\n\
        \Top variable : TOP\n\
        \Nested variable : NESTED_TWO\n\
        \"

-- Nested generic context with polymorphic datatypes
data Person = Person { personName :: String } deriving (Data, Typeable)
data Info = Info { person :: Maybe Person } deriving (Data, Typeable)
data Infos = Infos { infos :: [Info] } deriving (Data, Typeable)

nestedPolyGenericContextTest = do
    res <- hastacheStr defaultConfig (encodeStr template) context
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    datum = Infos [Info Nothing, Info $ Just $ Person "Dude", Info $ Just $ Person "Dude2"]
    template = "Greetings: {{#infos}}{{#person}}Hello, {{personName}}!\n{{/person}}{{/infos}}"
    context = mkGenericContext datum
    testRes = "Greetings: Hello, Dude!\nHello, Dude2!\n"

-- Generic context with custom extension
data MyData = MyData Int deriving (Data, Typeable)
data TestInfo = TestInfo {n::Int,m::MyData} deriving (Data, Typeable)

testExt :: Ext
testExt = defaultExt `extQ` (\(MyData i) -> "Data " ++ show i)

genericExtTest = do
    res <- hastacheStr defaultConfig (encodeStr template) context
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    datum = TestInfo 1 (MyData 0)
    template = "{{n}}\n{{m.MyData}}"
    context = mkGenericContext' id testExt datum
    testRes = "1\nData 0"


-- Accessing array item by index
arrayItemsTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkStrContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \{{section.0.name}} {{section.1.name}} {{section.2.name}}\n\
        \{{#flags.0.val}}yes{{/flags.0.val}}\n\
        \{{^flags.1.val}}no{{/flags.0.val}}\n\
        \"
    context "section" = MuList $ map nameCtx ["Neo", "Morpheus", "Trinity"]
    context "flags" = MuList $ map flagCtx [True, False]
    context n = MuNothing
    nameCtx name = mkStrContext (\"name" -> MuVariable name)
    flagCtx val = mkStrContext (\"val" -> MuBool val)

    testRes = "\
        \Neo Morpheus Trinity\n\
        \yes\n\
        \no\n\
        \"

-- Accessing array item by index (generic version)
data ArrayItemTest_Item = ArrayItemTest_Item {
    name :: String
    } deriving (Data, Typeable)

data ArrayItemTest_Container = ArrayItemTest_Container {
    items       :: [ArrayItemTest_Item],
    itemsStr    :: [String]
    } deriving (Data, Typeable)

arrayItemsTestGeneric = do
    res <- hastacheStr defaultConfig (encodeStr template) context
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    template = "\
        \{{items.0.name}} {{items.2.name}}\n\
        \{{itemsStr.0}} {{itemsStr.1}}\n\
        \"
    context = mkGenericContext $ ArrayItemTest_Container {
        items = [ArrayItemTest_Item "Bob", ArrayItemTest_Item "Alice",
                 ArrayItemTest_Item "Zoe"],
        itemsStr = ["Bob", "Alice", "Zoe"]
    }
    testRes = "\
        \Bob Zoe\n\
        \Bob Alice\n\
        \"

-- Multiple constructors in generic contexts
data Hero = Good { goodness :: Int }
          | Evil { evilness :: Int }
          deriving (Data, Typeable)

data Heroes = Heroes { heroes :: [Hero] }
            deriving (Data, Typeable)

multipleConstrTest = do
    res <- hastacheStr defaultConfig (encodeStr template)
        (mkGenericContext context)
    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    context  = Heroes [Good 4, Evil 2]
    template = "\
        \{{#heroes}}\
        \{{#Good}}{{goodness}}{{/Good}}\
        \{{#Evil}}{{evilness}}{{/Evil}}\
        \{{/heroes}}\
        \"
    testRes = "42"

-- Context composition
compositionTest = do
    res <- hastacheStr defaultConfig (encodeStr template) $
        mkGenericContext context 
        `composeCtx` mempty
        `composeCtx` mkStrContext context2

    assertEqualStr resCorrectness (decodeStrLT res) testRes
    where
    context  = Heroes [Good 4, Evil 2]
    context2 "Ugly" = MuVariable (3::Int)
    context2 _      = MuNothing
    template = "\
        \{{#heroes}}\
        \{{#Good}}{{goodness}}{{/Good}}\
        \{{#Evil}}{{evilness}}{{/Evil}}\
        \{{#Ugly}}{{Ugly}}{{/Ugly}}\
        \{{/heroes}}\
        \"
    testRes = "4323"

tests = TestList [
      TestLabel "Comments test" (TestCase commentsTest)
    , TestLabel "Variables test" (TestCase variablesTest)
    , TestLabel "Show/hide sections test" (TestCase showHideSectionsTest)
    , TestLabel "List test" (TestCase listSectionTest)
    , TestLabel "Bool test" (TestCase boolSectionTest)
    , TestLabel "Lambda test" (TestCase lambdaSectionTest)
    , TestLabel "LambdaM test" (TestCase lambdaMSectionTest)
    , TestLabel "Monadic context test" (TestCase monadicContextTest)
    , TestLabel "Set delimiter test" (TestCase setDelimiterTest)
    , TestLabel "Partials test" (TestCase partialsTest)
    , TestLabel "Generic context test" (TestCase genericContextTest)
    , TestLabel "Multiple constructors in a generic context"
        (TestCase multipleConstrTest)    
    , TestLabel "Nested context test" (TestCase nestedContextTest)
    , TestLabel "Nested generic context test"
                                        (TestCase nestedGenericContextTest)

    , TestLabel "Nested generic context with polymorphic datatypes test"
                                        (TestCase nestedPolyGenericContextTest)
    , TestLabel "Accessing array item by index" (TestCase arrayItemsTest)
    , TestLabel "Accessing array item by index (generic version)"
        (TestCase arrayItemsTestGeneric)
    , TestLabel "Composing contexts" (TestCase compositionTest)
    , TestLabel "Generic contexts with custom extensions" (TestCase genericExtTest)
    ]

main = do
    setCurrentDirectory "./tests/"
    trs <- runTestTT tests
    if (errors trs /= 0) || (failures trs /= 0)
        then exitFailure
        else exitSuccess

assertEqualStr preface actual expected =
    unless (actual == expected) (assertFailure msg)
    where
    msg = (if null preface then "" else preface ++ "\n") ++
        "expected: \n" ++ expected ++ "\nbut got: \n" ++ actual