Contrib.hs

module Test.Contrib (contribTests) where

import Data.ByteString (ByteString)
import Flow
import System.FilePath (joinPath)
import Test.Helpers
import Test.Tasty
import Test.Tasty.HUnit

import qualified Data.Aeson.Types as Aeson (Value(..))
import qualified Data.ByteString as B (empty)
import qualified Data.ByteString.Char8 as BS (intercalate, pack)
import qualified Data.HashMap.Strict as HashMap (fromList, lookup)
import qualified Data.List as List (head, reverse)
import qualified Data.Text as Text (pack, unpack)
import qualified Data.Text.IO as Text (readFile)
import qualified Data.Text.Encoding as Text (decodeUtf8)
import qualified Shikensu
import qualified Shikensu.Contrib as Contrib
import qualified Shikensu.Contrib.IO as Contrib.IO
import qualified Shikensu.Types as Shikensu


contribTests :: TestTree
contribTests = testGroup
    "Contrib tests"
    [ testClone
    , testExclude
    , testMetadata
    , testPermalink
    , testPrefixDirname
    , testRead
    , testRename
    , testRenameExt
    , testRenderContent
    , testWrite
    ]




-- Test data


list :: Shikensu.Pattern -> IO Shikensu.Dictionary
list pattern =
    rootPath >>= Shikensu.listF [pattern]


example_md :: IO Shikensu.Dictionary
example_md =
    list "tests/fixtures/example.md"


renderer :: Shikensu.Definition -> Maybe ByteString
renderer def =
    let
        openingTag = BS.pack "<html>"
        closingTag = BS.pack "</html>"
    in
        def
            |> Shikensu.content
            |> fmap (\c -> BS.intercalate B.empty [openingTag, c, closingTag])




-- Tests


testClone :: TestTree
testClone =
    let
        dictionary = fmap (Contrib.clone "example.md" "cloned.md") example_md
        definition = fmap (List.head . List.reverse) dictionary
    in
        testCase "Should `clone`"
        $ definition `rmap` Shikensu.localPath >>= assertEq "cloned.md"



testExclude :: TestTree
testExclude =
    let
        dictionary = fmap (Contrib.exclude "example.md") example_md
        length_ = fmap length dictionary
    in
        testCase "Should `exclude`"
        $ length_ >>= assertEq 0



testMetadata :: TestTree
testMetadata =
    let
        keyA        = Text.pack "title"
        valueA      = Aeson.String (Text.pack "Hello world!")

        keyB        = Text.pack "hello"
        valueB      = Aeson.String (Text.pack "Guardian.")

        keyC        = Text.pack "removed"
        valueC      = Aeson.String (Text.pack "Me.")

        keyBase     = Text.pack "basename"
        valueBase   = Aeson.String (Text.pack "example")

        -- 1. Insert C
        -- 2. Replace with A
        -- 3. Insert B
        dictionary = example_md
            <&> ( Contrib.insertMetadata (HashMap.fromList [ (keyC, valueC) ])
               .> Contrib.replaceMetadata (HashMap.fromList [ (keyA, valueA) ])
               .> Contrib.copyPropsToMetadata
               .> Contrib.insertMetadata (HashMap.fromList [ (keyB, valueB) ])
            )

        definition = fmap (List.head . List.reverse) dictionary

        lookupTitle = \def -> HashMap.lookup keyA (Shikensu.metadata def)
        lookupHello = \def -> HashMap.lookup keyB (Shikensu.metadata def)
        lookupRemoved = \def -> HashMap.lookup keyC (Shikensu.metadata def)
        lookupBasename = \def -> HashMap.lookup keyBase (Shikensu.metadata def)
    in
        testGroup
            "Metadata"
            [ testCase "Should no longer have `removed` key"
            $ definition `rmap` lookupRemoved >>= assertEq Nothing

            , testCase "Should have `hello` key"
            $ definition `rmap` lookupHello >>= assertEq (Just valueB)

            , testCase "Should have `title` key"
            $ definition `rmap` lookupTitle >>= assertEq (Just valueA)

            , testCase "Should have `basename` key"
            $ definition `rmap` lookupBasename >>= assertEq (Just valueBase)
            ]



testPermalink :: TestTree
testPermalink =
    let
        dictionary = fmap (Contrib.permalink "index") example_md
        definition = fmap (List.head) dictionary
    in
        testGroup
            "Permalink"
            [ testCase "Should have the correct `localPath`"
            $ definition `rmap` Shikensu.localPath >>= assertEq "example/index.md"

            , testCase "Should have the correct `parentPath`"
            $ definition `rmap` Shikensu.parentPath >>= assertEq (Just "../")

            , testCase "Should have the correct `pathToRoot`"
            $ definition `rmap` Shikensu.pathToRoot >>= assertEq "../"
            ]



testPrefixDirname :: TestTree
testPrefixDirname =
    let
        dictionary = fmap (Contrib.prefixDirname "prefix/") (list "tests/**/example.md")
        definition = fmap List.head dictionary
    in
        testGroup
            "PrefixDirname"
            [ testCase "Should have the correct `dirname`"
            $ definition `rmap` Shikensu.dirname >>= assertEq "prefix/fixtures"

            , testCase "Should have the correct `pathToRoot`"
            $ definition `rmap` Shikensu.pathToRoot >>= assertEq "../../"

            , testCase "Should have the correct `parentPath`"
            $ definition `rmap` Shikensu.parentPath >>= assertEq (Just "../")
            ]



testRead :: TestTree
testRead =
    let
        dictionary = example_md >>= Contrib.IO.read
        definition = fmap List.head dictionary
    in
        testCase "Should `read`"
        $ definition
            <&> Shikensu.content
            <&> fmap Text.decodeUtf8
            >>= assertEq (Just (Text.pack "# Example\n"))



testRename :: TestTree
testRename =
    let
        dictionary = fmap (Contrib.rename "example.md" "renamed.md") example_md
        definition = fmap (List.head) dictionary
    in
        testCase "Should `rename`"
        $ definition `rmap` Shikensu.localPath >>= assertEq "renamed.md"



testRenameExt :: TestTree
testRenameExt =
    let
        dictionary = fmap (Contrib.renameExt ".md" ".html") example_md
        definition = fmap (List.head) dictionary
    in
        testCase "Should `renameExt`"
        $ definition `rmap` Shikensu.extname >>= assertEq ".html"



testRenderContent :: TestTree
testRenderContent =
    let
        dictionary = fmap (Contrib.renderContent renderer) (example_md >>= Contrib.IO.read)
        definition = fmap (List.head) dictionary
        expectedResult = Just (Text.pack "<html># Example\n</html>")
    in
        testCase "Should `renderContent`"
        $ definition
            <&> Shikensu.content
            <&> fmap Text.decodeUtf8
            >>= assertEq expectedResult



testWrite :: TestTree
testWrite =
    let
        destination = "tests/build/"
        dictionary = list "tests/**/example.md" >>= Contrib.IO.read >>= Contrib.IO.write destination
        definition = fmap List.head dictionary
    in
        testCase "Should `write`"
        $ definition
            <&> Shikensu.rootDirname
            >>= \r -> Text.readFile (joinPath [r, destination, "fixtures/example.md"])
            >>= \c -> assertEq "# Example\n" (Text.unpack c)