2017-04-19 23:25:46 +03:00
|
|
|
{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies, TypeOperators #-}
|
|
|
|
module SpecHelpers
|
2017-04-20 02:33:27 +03:00
|
|
|
( diffFilePaths
|
|
|
|
, parseFilePath
|
2017-12-10 19:46:17 +03:00
|
|
|
, readFilePair
|
2017-05-10 01:49:38 +03:00
|
|
|
, languageForFilePath
|
2017-04-19 23:25:46 +03:00
|
|
|
) where
|
2017-04-19 19:12:19 +03:00
|
|
|
|
2017-12-10 19:46:17 +03:00
|
|
|
import Control.Monad ((<=<))
|
2017-07-28 21:37:02 +03:00
|
|
|
import Control.Exception
|
2017-06-24 17:09:50 +03:00
|
|
|
import Data.Blob
|
2017-04-19 19:12:19 +03:00
|
|
|
import qualified Data.ByteString as B
|
2017-04-19 23:25:46 +03:00
|
|
|
import Data.Functor.Both
|
2017-11-27 22:17:48 +03:00
|
|
|
import Data.Language
|
2017-12-11 21:51:52 +03:00
|
|
|
import Data.Maybe (fromMaybe, fromJust)
|
2017-06-24 16:59:41 +03:00
|
|
|
import Data.Source
|
2017-11-27 21:30:38 +03:00
|
|
|
import Rendering.Renderer
|
2017-04-20 02:33:27 +03:00
|
|
|
import Semantic
|
2017-05-30 16:14:50 +03:00
|
|
|
import Semantic.Task
|
2017-12-10 19:46:17 +03:00
|
|
|
import qualified Semantic.IO as IO
|
2017-04-19 19:45:08 +03:00
|
|
|
import System.FilePath
|
2017-04-19 19:12:19 +03:00
|
|
|
|
2017-04-19 23:25:46 +03:00
|
|
|
-- | Returns an s-expression formatted diff for the specified FilePath pair.
|
2017-07-28 21:37:02 +03:00
|
|
|
diffFilePaths :: Both FilePath -> IO B.ByteString
|
2017-12-10 19:46:17 +03:00
|
|
|
diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionDiffRenderer
|
2017-04-19 23:25:46 +03:00
|
|
|
|
|
|
|
-- | Returns an s-expression parse tree for the specified FilePath.
|
2017-07-28 21:37:02 +03:00
|
|
|
parseFilePath :: FilePath -> IO B.ByteString
|
2017-12-11 21:51:52 +03:00
|
|
|
parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer
|
2017-04-21 23:56:19 +03:00
|
|
|
|
2017-12-11 19:27:13 +03:00
|
|
|
-- | Read two files to a BlobPair.
|
|
|
|
readFilePair :: Both FilePath -> IO BlobPair
|
|
|
|
readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in
|
|
|
|
runBothWith IO.readFilePair paths'
|
2017-05-11 16:28:52 +03:00
|
|
|
|
2017-05-10 01:49:38 +03:00
|
|
|
-- | Returns a Maybe Language based on the FilePath's extension.
|
|
|
|
languageForFilePath :: FilePath -> Maybe Language
|
2017-07-28 21:37:02 +03:00
|
|
|
languageForFilePath = languageForType . takeExtension
|