From fcf7155a35291e1e9908d1aae0c46bc78f58692b Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Wed, 17 May 2017 10:02:18 -0700
Subject: [PATCH] Extract Command.Stdin

---
 semantic-diff.cabal  |  1 +
 src/Command.hs       |  3 ++-
 src/Command/Files.hs | 49 +-----------------------------------------
 src/Command/Stdin.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 55 insertions(+), 49 deletions(-)
 create mode 100644 src/Command/Stdin.hs

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 0c418e541..ea7f1af8e 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -20,6 +20,7 @@ library
                      , Command
                      , Command.Files
                      , Command.Git
+                     , Command.Stdin
                      , Data.Align.Generic
                      , Data.Functor.Both
                      , Data.Functor.Classes.Eq.Generic
diff --git a/src/Command.hs b/src/Command.hs
index 316d94165..8cf398a67 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -12,6 +12,7 @@ module Command
 
 import qualified Command.Files as Files
 import qualified Command.Git as Git
+import qualified Command.Stdin as Stdin
 import Control.Monad.Free.Freer
 import Control.Monad.IO.Class
 import Data.Functor.Both
@@ -59,7 +60,7 @@ readFilesAtSHAs gitDir alternates paths shas = ReadFilesAtSHAs gitDir alternates
 runCommand :: Command a -> IO a
 runCommand = iterFreerA $ \ command yield -> case command of
   ReadFile path lang -> Files.readFile path lang >>= yield
-  ReadStdin -> Files.readStdin >>= yield
+  ReadStdin -> Stdin.readStdin >>= yield
   ReadFilesAtSHA gitDir alternates paths sha -> Git.readFilesAtSHA gitDir alternates paths sha >>= yield
   ReadFilesAtSHAs gitDir alternates paths shas -> Git.readFilesAtSHAs gitDir alternates paths shas >>= yield
   LiftIO io -> io >>= yield
diff --git a/src/Command/Files.hs b/src/Command/Files.hs
index 29c905da9..493226acc 100644
--- a/src/Command/Files.hs
+++ b/src/Command/Files.hs
@@ -1,9 +1,8 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveGeneric, DeriveAnyClass, TypeSynonymInstances #-}
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
 module Command.Files
 ( readFile
 , transcode
 , languageForFilePath
-, readStdin
 ) where
 
 import Prologue hiding (readFile)
@@ -15,10 +14,6 @@ import Control.Exception (catch, IOException)
 import qualified Data.Text.ICU.Convert as Convert
 import qualified Data.Text.ICU.Detect as Detect
 
-import qualified Control.Applicative as A
-import Data.String
-import Data.Aeson
-import Data.Functor.Both
 
 -- | Read a file to a SourceBlob, transcoding to UTF-8 along the way.
 readFile :: FilePath -> Maybe Language -> IO SourceBlob
@@ -37,45 +32,3 @@ transcode text = fromText <$> do
 -- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported.
 languageForFilePath :: FilePath -> Maybe Language
 languageForFilePath = languageForType . toS . takeExtension
-
-
--- PROTOTYPE
-
-readStdin :: IO [Both SourceBlob]
-readStdin = do
-  input <- B.getContents
-  let request = decode (toS input) :: Maybe DiffRequest
-  pure $ maybe mempty sourceBlobs request
-
-
-newtype DiffRequest = DiffRequest
-  { blobs :: [BlobPair]
-  } deriving (Show, Generic, FromJSON, ToJSON)
-
-data BlobPair = BlobPair
-  { path :: String
-  , before :: Maybe BlobContent
-  , after :: Maybe BlobContent
-  } deriving (Show, Generic, FromJSON, ToJSON)
-
-newtype BlobContent = BlobContent { utf8Text :: ByteString }
-  deriving (Eq, Show)
-
-instance ToJSON BlobContent where
-  toJSON = String . decodeUtf8 . utf8Text
-
-instance FromJSON BlobContent where
-  parseJSON (String t) = (pure . BlobContent . encodeUtf8) t
-  parseJSON _ = A.empty
-
-sourceBlobs :: DiffRequest -> [Both SourceBlob]
-sourceBlobs DiffRequest{..} = toSourceBlob <$> blobs
-  where
-    toSourceBlob :: BlobPair -> Both SourceBlob
-    toSourceBlob BlobPair{..} = fmap (sourceBlob' path) (both before after)
-
-    sourceBlob' :: FilePath -> Maybe BlobContent -> SourceBlob
-    sourceBlob' path maybeContent = maybe (emptySourceBlob path) (sourceBlob path (languageForFilePath path)) (source' maybeContent)
-
-    source' :: Maybe BlobContent -> Maybe Source
-    source' = fmap (Source . utf8Text)
diff --git a/src/Command/Stdin.hs b/src/Command/Stdin.hs
new file mode 100644
index 000000000..ab0b7a794
--- /dev/null
+++ b/src/Command/Stdin.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE RecordWildCards, DeriveGeneric, DeriveAnyClass, TypeSynonymInstances #-}
+module Command.Stdin
+( readStdin
+) where
+
+import Command.Files (languageForFilePath)
+import qualified Control.Applicative as A
+import Data.Aeson
+import qualified Data.ByteString as B
+import Data.Functor.Both
+import Data.String
+import Prologue
+import Source
+
+readStdin :: IO [Both SourceBlob]
+readStdin = do
+  input <- B.getContents
+  let request = decode (toS input) :: Maybe BlobDiff
+  pure $ maybe mempty sourceBlobs request
+
+
+newtype BlobDiff = BlobDiff { blobs :: [BlobPair] }
+  deriving (Show, Generic, FromJSON, ToJSON)
+
+data BlobPair = BlobPair
+  { path :: String
+  , before :: Maybe BlobContent
+  , after :: Maybe BlobContent
+  } deriving (Show, Generic, FromJSON, ToJSON)
+
+newtype BlobContent = BlobContent { utf8Text :: ByteString }
+  deriving (Eq, Show)
+
+instance ToJSON BlobContent where
+  toJSON = String . decodeUtf8 . utf8Text
+
+instance FromJSON BlobContent where
+  parseJSON (String t) = (pure . BlobContent . encodeUtf8) t
+  parseJSON _ = A.empty
+
+sourceBlobs :: BlobDiff -> [Both SourceBlob]
+sourceBlobs BlobDiff{..} = toSourceBlob <$> blobs
+  where
+    toSourceBlob :: BlobPair -> Both SourceBlob
+    toSourceBlob BlobPair{..} = fmap (sourceBlob' path) (both before after)
+
+    sourceBlob' :: FilePath -> Maybe BlobContent -> SourceBlob
+    sourceBlob' path maybeContent = maybe (emptySourceBlob path) (sourceBlob path (languageForFilePath path)) (source' maybeContent)
+
+    source' :: Maybe BlobContent -> Maybe Source
+    source' = fmap (Source . utf8Text)