restless-git-0.5.0: test/Test.hs

{-# Language LambdaCase #-}
{-# Language NamedFieldPuns #-}
{-# Language OverloadedStrings #-}
{-# Language PatternSynonyms #-}
{-# Language RecordWildCards #-}
{-# Language ViewPatterns #-}

import Restless.Git

import Test.Tasty
import Test.Tasty.HUnit

import Data.ByteString        (ByteString)
import Data.Set               (toList)
import System.IO.Temp         (withSystemTempDirectory)
import Text.Read              (readMaybe)

import qualified Data.ByteString.Char8  as C8
import qualified Data.Set               as Set

main :: IO ()
main = defaultMain tests

tests :: TestTree
tests = testGroup "roundtrip"
  [ testCase "simple example" roundtripExample ]

data Example = Example
  { foo :: Int
  , bar :: Int
  } deriving (Eq, Show)

readBytesMaybe :: Read a => ByteString -> Maybe a
readBytesMaybe = readMaybe . C8.unpack

pattern Reads :: Read a => a -> ByteString
pattern Reads x <- (readBytesMaybe -> Just x)

class Filing a where
  fromFiles :: [File] -> a
  toFiles   :: a -> [File]

instance Filing Example where
  fromFiles = foldl f (Example 0 0)
    where
      f :: Example -> File -> Example
      f x = \case
        File (Path ["example", "foo"] "x") (Reads foo) ->
          x { foo }
        File (Path ["example", "bar"] "x") (Reads bar) ->
          x { bar }
        _ ->
          x
  toFiles Example {..} =
    [ File (Path ["example", "foo"] "x") (C8.pack (show foo))
    , File (Path ["example", "bar"] "x") (C8.pack (show bar))
    ]

roundtripExample :: Assertion
roundtripExample = do
  let x = Example 5 7
  y <- withSystemTempDirectory "restless-git-test" $ \path -> do
    make path
    save path "hello" (Set.fromList (toFiles x))
    (fromFiles . toList) <$> load path
  assertEqual "roundtrip failed" x y