1
1
mirror of https://github.com/github/semantic.git synced 2024-12-24 23:42:31 +03:00

Refactor IO back out into Source and SemanticDiff

This commit is contained in:
Timothy Clem 2017-02-28 15:45:38 -08:00
parent bfe1181acb
commit fff9b6d3ef
8 changed files with 49 additions and 63 deletions

View File

@ -49,7 +49,6 @@ library
, Renderer.SExpression
, Renderer.TOC
, SemanticDiff
, SemanticDiff.IO
, SES
, Source
, SourceSpan

View File

@ -32,7 +32,6 @@ import Renderer.SExpression
import Renderer.Split
import Renderer.Summary
import Renderer.TOC
import SemanticDiff.IO
import Source
import Syntax
import Term

View File

@ -24,7 +24,6 @@ import Text.Parser.TreeSitter.C
import Text.Parser.TreeSitter.Go
import Text.Parser.TreeSitter.JavaScript
import Text.Parser.TreeSitter.Ruby
import SemanticDiff.IO
data ParseJSON = ParseJSON
{ category :: Text

View File

@ -13,7 +13,9 @@ import qualified Renderer as R
import Development.GitRev
import DiffCommand
import ParseCommand
import SemanticDiff.IO
import qualified Data.Text.IO as TextIO
import System.IO
import System.Environment (lookupEnv)
main :: IO ()
main = do
@ -56,3 +58,18 @@ versionString = "semantic-diff version " <> showVersion Library.version <> " ("
version :: Parser (a -> a)
version = infoOption versionString (long "version" <> short 'V' <> help "output the version of the program")
writeToOutput :: Maybe FilePath -> Text -> IO ()
writeToOutput output text = case output of
Nothing -> do
setEncoding
TextIO.hPutStrLn stdout text
Just path -> withFile path WriteMode (`TextIO.hPutStr` text)
where
setEncoding = do
lang <- lookupEnv "LANG"
case lang of
-- If LANG is set and isn't the empty string, leave the encoding.
Just x | x /= "" -> pure ()
-- Otherwise default to utf8.
_ -> hSetEncoding stdout utf8

View File

@ -1,56 +0,0 @@
module SemanticDiff.IO where
import Prelude
import Data.Text
import qualified Data.Text.IO as TextIO
import System.IO
import System.Environment (lookupEnv)
import Control.Exception (catch, IOException)
import qualified Data.ByteString as B1
import qualified Data.Text.ICU.Convert as Convert
import qualified Data.Text.ICU.Detect as Detect
import Source
writeToOutput :: Maybe FilePath -> Text -> IO ()
writeToOutput output text = case output of
Nothing -> do
setEncoding
TextIO.hPutStrLn stdout text
Just path -> withFile path WriteMode (`TextIO.hPutStr` text)
where
setEncoding = do
lang <- lookupEnv "LANG"
case lang of
-- If LANG is set and isn't the empty string, leave the encoding.
Just x | x /= "" -> pure ()
-- Otherwise default to utf8.
_ -> hSetEncoding stdout utf8
-- | Read the file and convert it to Unicode.
readAndTranscodeFile :: FilePath -> IO Source
readAndTranscodeFile path = do
size <- fileSize path
text <- case size of
0 -> pure B1.empty
_ -> B1.readFile path
transcode text
-- From https://github.com/haskell/bytestring/pull/79/files
fileSize :: FilePath -> IO Integer
fileSize f = withBinaryFile f ReadMode $ \h -> do
-- hFileSize fails if file is not regular file (like /dev/null). Catch
-- exception and try reading anyway.
filesz <- catch (hFileSize h) useZeroIfNotRegularFile
pure $ fromIntegral filesz `max` 0
where useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile _ = pure 0
-- | Transcode a file to a unicode source.
transcode :: B1.ByteString -> IO Source
transcode text = fromText <$> do
match <- Detect.detectCharset text
converter <- Convert.open match Nothing
pure $ Convert.toUnicode converter text

View File

@ -2,6 +2,7 @@
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Source where
import Prelude (FilePath, fromIntegral)
import Prologue
import qualified Data.ByteString as B
import qualified Data.Text as T
@ -9,6 +10,10 @@ import Numeric
import Range
import SourceSpan
import Test.LeanCheck
import System.IO
import Control.Exception (catch, IOException)
import qualified Data.Text.ICU.Convert as Convert
import qualified Data.Text.ICU.Detect as Detect
-- | The source, oid, path, and Maybe SourceKind of a blob in a Git repo.
data SourceBlob = SourceBlob { source :: Source, oid :: T.Text, path :: FilePath, blobKind :: Maybe SourceKind }
@ -22,12 +27,37 @@ newtype Source = Source { sourceText :: B.ByteString }
data SourceKind = PlainBlob Word32 | ExecutableBlob Word32 | SymlinkBlob Word32
deriving (Show, Eq)
-- | Read the file and convert it to Unicode.
readAndTranscodeFile :: FilePath -> IO Source
readAndTranscodeFile path = do
size <- fileSize path
text <- case size of
0 -> pure B.empty
_ -> B.readFile path
transcode text
-- From https://github.com/haskell/bytestring/pull/79/files
fileSize :: FilePath -> IO Integer
fileSize f = withBinaryFile f ReadMode $ \h -> do
-- hFileSize fails if file is not regular file (like /dev/null). Catch
-- exception and try reading anyway.
filesz <- catch (hFileSize h) useZeroIfNotRegularFile
pure $ fromIntegral filesz `max` 0
where useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile _ = pure 0
-- | Transcode a file to a unicode source.
transcode :: B.ByteString -> IO Source
transcode text = fromText <$> do
match <- Detect.detectCharset text
converter <- Convert.open match Nothing
pure $ Convert.toUnicode converter text
modeToDigits :: SourceKind -> Text
modeToDigits (PlainBlob mode) = toS $ showOct mode ""
modeToDigits (ExecutableBlob mode) = toS $ showOct mode ""
modeToDigits (SymlinkBlob mode) = toS $ showOct mode ""
-- | The default plain blob mode
defaultPlainBlob :: SourceKind
defaultPlainBlob = PlainBlob 0o100644

View File

@ -14,7 +14,6 @@ import Renderer
import Renderer.SExpression as Renderer
import Source
import DiffCommand
import SemanticDiff.IO (readAndTranscodeFile)
import System.FilePath
import System.FilePath.Glob
import Test.Hspec (Spec, describe, it, SpecWith, runIO, parallel)

View File

@ -10,7 +10,6 @@ import Data.Record
import Data.String
import Diff
import DiffCommand
import SemanticDiff.IO (readAndTranscodeFile)
import Info
import Interpreter
import ParseCommand