{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}

module Highlight.Common.Monad.Input
  ( FileOrigin(..)
  , FileReader(..)
  , getFileOriginFromFileReader
  , getFilePathFromFileReader
  , InputData(..)
  , createInputData
  , FilenameHandlingFromFiles(..)
  ) where

import Prelude ()
import Prelude.Compat

import Control.Exception (IOException, try)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.ByteString (ByteString)
import Data.List (sort)
import Pipes
       (Pipe, Producer, Proxy, (>->), await, each, for, next,
        yield)
import Pipes.Prelude (toListM)
import qualified Pipes.Prelude as Pipes
import System.IO (Handle)

import Highlight.Common.Options
       (InputFilename(unInputFilename), Recursive(Recursive))
import Highlight.Pipes (childOf, fromHandleLines)
import Highlight.Util (combineApplicatives, openFilePathForReading)

-----------
-- Pipes --
-----------

-- | Place where a file originally came from.
data FileOrigin
  = FileSpecifiedByUser FilePath
  -- ^ File was specified on the command line by the user.
  | FileFoundRecursively FilePath
  -- ^ File was found recursively (not directly specified by the user).
  | Stdin
  -- ^ Standard input.  It was either specified on the command line as @-@, or
  -- used as default because the user did not specify any files.
  deriving (FileOrigin -> FileOrigin -> Bool
(FileOrigin -> FileOrigin -> Bool)
-> (FileOrigin -> FileOrigin -> Bool) -> Eq FileOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileOrigin -> FileOrigin -> Bool
$c/= :: FileOrigin -> FileOrigin -> Bool
== :: FileOrigin -> FileOrigin -> Bool
$c== :: FileOrigin -> FileOrigin -> Bool
Eq, ReadPrec [FileOrigin]
ReadPrec FileOrigin
Int -> ReadS FileOrigin
ReadS [FileOrigin]
(Int -> ReadS FileOrigin)
-> ReadS [FileOrigin]
-> ReadPrec FileOrigin
-> ReadPrec [FileOrigin]
-> Read FileOrigin
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileOrigin]
$creadListPrec :: ReadPrec [FileOrigin]
readPrec :: ReadPrec FileOrigin
$creadPrec :: ReadPrec FileOrigin
readList :: ReadS [FileOrigin]
$creadList :: ReadS [FileOrigin]
readsPrec :: Int -> ReadS FileOrigin
$creadsPrec :: Int -> ReadS FileOrigin
Read, Int -> FileOrigin -> ShowS
[FileOrigin] -> ShowS
FileOrigin -> String
(Int -> FileOrigin -> ShowS)
-> (FileOrigin -> String)
-> ([FileOrigin] -> ShowS)
-> Show FileOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileOrigin] -> ShowS
$cshowList :: [FileOrigin] -> ShowS
show :: FileOrigin -> String
$cshow :: FileOrigin -> String
showsPrec :: Int -> FileOrigin -> ShowS
$cshowsPrec :: Int -> FileOrigin -> ShowS
Show)

-- | Get a 'FilePath' from a 'FileOrigin'.
--
-- >>> getFilePathFromFileOrigin $ FileSpecifiedByUser "hello.txt"
-- Just "hello.txt"
-- >>> getFilePathFromFileOrigin $ FileFoundRecursively "bye.txt"
-- Just "bye.txt"
-- >>> getFilePathFromFileOrigin Stdin
-- Nothing
getFilePathFromFileOrigin :: FileOrigin -> Maybe FilePath
getFilePathFromFileOrigin :: FileOrigin -> Maybe String
getFilePathFromFileOrigin (FileSpecifiedByUser String
fp) = String -> Maybe String
forall a. a -> Maybe a
Just String
fp
getFilePathFromFileOrigin (FileFoundRecursively String
fp) = String -> Maybe String
forall a. a -> Maybe a
Just String
fp
getFilePathFromFileOrigin FileOrigin
Stdin = Maybe String
forall a. Maybe a
Nothing

-- | This is used in two different places.
--
-- One is in 'fileListProducer', where @a@ becomes 'Handle'.  This represents a
-- single file that has been opened.  'FileReaderSuccess' contains the
-- 'FileOrigin' and the 'Handle'.  'FileReaderErr' contains the 'FileOrigin'
-- and any errors that occurred when trying to open the 'Handle'.
--
-- The other is in 'fileReaderHandleToLine' and 'InputData', where @a@ becomes
-- 'ByteString'.  This represents a single 'ByteString' line from a file, or an
-- error that occurred when trying to read the file.
--
-- 'FileReader' is usually wrapped in a 'Producer'.  This is a stream of either
-- 'Handle's or 'ByteString' lines (with any errors that have occurred).
data FileReader a
  = FileReaderSuccess !FileOrigin !a
  | FileReaderErr !FileOrigin !IOException !(Maybe IOException)
  deriving (FileReader a -> FileReader a -> Bool
(FileReader a -> FileReader a -> Bool)
-> (FileReader a -> FileReader a -> Bool) -> Eq (FileReader a)
forall a. Eq a => FileReader a -> FileReader a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileReader a -> FileReader a -> Bool
$c/= :: forall a. Eq a => FileReader a -> FileReader a -> Bool
== :: FileReader a -> FileReader a -> Bool
$c== :: forall a. Eq a => FileReader a -> FileReader a -> Bool
Eq, Int -> FileReader a -> ShowS
[FileReader a] -> ShowS
FileReader a -> String
(Int -> FileReader a -> ShowS)
-> (FileReader a -> String)
-> ([FileReader a] -> ShowS)
-> Show (FileReader a)
forall a. Show a => Int -> FileReader a -> ShowS
forall a. Show a => [FileReader a] -> ShowS
forall a. Show a => FileReader a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileReader a] -> ShowS
$cshowList :: forall a. Show a => [FileReader a] -> ShowS
show :: FileReader a -> String
$cshow :: forall a. Show a => FileReader a -> String
showsPrec :: Int -> FileReader a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FileReader a -> ShowS
Show)

-- | Get a 'FileOrigin' from a 'FileReader'.
--
-- >>> let fileOrigin1 = FileSpecifiedByUser "hello.txt"
-- >>> let fileReader1 = FileReaderSuccess fileOrigin1 "some line"
-- >>> getFileOriginFromFileReader fileReader1
-- FileSpecifiedByUser "hello.txt"
--
-- >>> let fileOrigin2 = FileFoundRecursively "bye.txt"
-- >>> let fileReader2 = FileReaderErr fileOrigin2 (userError "err") Nothing
-- >>> getFileOriginFromFileReader fileReader2
-- FileFoundRecursively "bye.txt"
getFileOriginFromFileReader :: FileReader a -> FileOrigin
getFileOriginFromFileReader :: FileReader a -> FileOrigin
getFileOriginFromFileReader (FileReaderSuccess FileOrigin
origin a
_) = FileOrigin
origin
getFileOriginFromFileReader (FileReaderErr FileOrigin
origin IOException
_ Maybe IOException
_) = FileOrigin
origin

-- | This is just
-- @'getFilePathFromFileOrigin' '.' 'getFileOriginFromFileReader'@.
--
-- >>> let fileOrigin1 = Stdin
-- >>> let fileReader1 = FileReaderSuccess fileOrigin1 "some line"
-- >>> getFilePathFromFileReader fileReader1
-- Nothing
--
-- >>> let fileOrigin2 = FileFoundRecursively "bye.txt"
-- >>> let fileReader2 = FileReaderErr fileOrigin2 (userError "err") Nothing
-- >>> getFilePathFromFileReader fileReader2
-- Just "bye.txt"
getFilePathFromFileReader :: FileReader a -> Maybe FilePath
getFilePathFromFileReader :: FileReader a -> Maybe String
getFilePathFromFileReader =
  FileOrigin -> Maybe String
getFilePathFromFileOrigin (FileOrigin -> Maybe String)
-> (FileReader a -> FileOrigin) -> FileReader a -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileReader a -> FileOrigin
forall a. FileReader a -> FileOrigin
getFileOriginFromFileReader

-- | This wraps up two pieces of information.
--
-- One is the value of 'FilenameHandlingFromFiles'.  This signals as to whether
-- or not we need to print the filename when printing each line of output.
--
-- This other is a 'Producer' of 'FileReader' 'ByteString's.  This is a
-- 'Producer' for each line of each input file.
--
-- The main job of this module is to define 'createInputData', which produces
-- 'InputData'.  'InputData' is what is processed to figure out what to output.
data InputData m a
  = InputData
      !FilenameHandlingFromFiles
      !(Producer (FileReader ByteString) m a)

-- | Create 'InputData' based 'InputFilename' list.
--
-- Setup for examples:
--
-- >>> :set -XOverloadedStrings
-- >>> import Highlight.Common.Options (InputFilename(InputFilename))
-- >>> import Highlight.Common.Options (Recursive(NotRecursive))
--
-- If the 'InputFilename' list is empty, just create an 'InputData' with
-- 'NoFilename' and the standard input 'Producer' passed in.
--
-- >>> let stdinProd = yield ("hello" :: ByteString)
-- >>> let create = createInputData NotRecursive [] stdinProd
-- >>> InputData NoFilename prod <- create
-- >>> toListM prod
-- [FileReaderSuccess Stdin "hello"]
--
-- If the 'InputFilename' list is not empty, create an 'InputData' with lines
-- from each file found on the command line.
--
-- >>> let inFiles = [InputFilename "test/golden/test-files/file1"]
-- >>> let create = createInputData NotRecursive inFiles stdinProd
-- >>> InputData NoFilename prod <- create
-- >>> Pipes.head prod
-- Just (FileReaderSuccess (FileSpecifiedByUser "test/golden/test-files/file1") "The...")
createInputData
  :: forall m.
     MonadIO m
  => Recursive
  -- ^ Whether or not to recursively read in files.
  -> [InputFilename]
  -- ^ List of files passed in on the command line.
  -> Producer ByteString m ()
  -- ^ A producer for standard input
  -> m (InputData m ())
createInputData :: Recursive
-> [InputFilename]
-> Producer ByteString m ()
-> m (InputData m ())
createInputData Recursive
recursive [InputFilename]
inputFilenames Producer ByteString m ()
stdinProducer = do
  let fileOrigins :: [FileOrigin]
fileOrigins = String -> FileOrigin
FileSpecifiedByUser (String -> FileOrigin)
-> (InputFilename -> String) -> InputFilename -> FileOrigin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputFilename -> String
unInputFilename (InputFilename -> FileOrigin) -> [InputFilename] -> [FileOrigin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [InputFilename]
inputFilenames
  case [FileOrigin]
fileOrigins of
    [] ->
      InputData m () -> m (InputData m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (InputData m () -> m (InputData m ()))
-> InputData m () -> m (InputData m ())
forall a b. (a -> b) -> a -> b
$
        FilenameHandlingFromFiles
-> Producer (FileReader ByteString) m () -> InputData m ()
forall (m :: * -> *) a.
FilenameHandlingFromFiles
-> Producer (FileReader ByteString) m a -> InputData m a
InputData FilenameHandlingFromFiles
NoFilename (Producer ByteString m () -> Producer (FileReader ByteString) m ()
forall x' x a (m :: * -> *) r.
Monad m =>
Proxy x' x () a m r -> Proxy x' x () (FileReader a) m r
stdinProducerToFileReader Producer ByteString m ()
stdinProducer)
    [FileOrigin]
_ -> do
      let fileListProducers :: [Proxy x' x () (FileReader Handle) m ()]
fileListProducers = (FileOrigin -> Proxy x' x () (FileReader Handle) m ())
-> [FileOrigin] -> [Proxy x' x () (FileReader Handle) m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Recursive -> FileOrigin -> Proxy x' x () (FileReader Handle) m ()
forall x' x (m :: * -> *).
MonadIO m =>
Recursive -> FileOrigin -> Proxy x' x () (FileReader Handle) m ()
fileListProducer Recursive
recursive) [FileOrigin]
fileOrigins
          fileProducer :: Proxy x' x () (FileReader Handle) m ()
fileProducer = (Proxy x' x () (FileReader Handle) m ()
 -> Proxy x' x () (FileReader Handle) m ()
 -> Proxy x' x () (FileReader Handle) m ())
-> [Proxy x' x () (FileReader Handle) m ()]
-> Proxy x' x () (FileReader Handle) m ()
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Proxy x' x () (FileReader Handle) m ()
-> Proxy x' x () (FileReader Handle) m ()
-> Proxy x' x () (FileReader Handle) m ()
forall (f :: * -> *) a.
(Applicative f, Semigroup a) =>
f a -> f a -> f a
combineApplicatives [Proxy x' x () (FileReader Handle) m ()]
forall x' x. [Proxy x' x () (FileReader Handle) m ()]
fileListProducers
      (FilenameHandlingFromFiles
filenameHandling, Producer (FileReader Handle) m ()
newFileProducer) <-
        Producer (FileReader Handle) m ()
-> m (FilenameHandlingFromFiles, Producer (FileReader Handle) m ())
forall a (m :: * -> *) r.
Monad m =>
Producer (FileReader a) m r
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
computeFilenameHandlingFromFiles Producer (FileReader Handle) m ()
forall x' x. Proxy x' x () (FileReader Handle) m ()
fileProducer
      let fileLineProducer :: Producer (FileReader ByteString) m ()
fileLineProducer = Producer (FileReader Handle) m ()
-> Producer (FileReader ByteString) m ()
forall (m :: * -> *) x' x r.
MonadIO m =>
Proxy x' x () (FileReader Handle) m r
-> Proxy x' x () (FileReader ByteString) m r
fileReaderHandleToLine Producer (FileReader Handle) m ()
newFileProducer
      InputData m () -> m (InputData m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (InputData m () -> m (InputData m ()))
-> InputData m () -> m (InputData m ())
forall a b. (a -> b) -> a -> b
$ FilenameHandlingFromFiles
-> Producer (FileReader ByteString) m () -> InputData m ()
forall (m :: * -> *) a.
FilenameHandlingFromFiles
-> Producer (FileReader ByteString) m a -> InputData m a
InputData FilenameHandlingFromFiles
filenameHandling Producer (FileReader ByteString) m ()
fileLineProducer

-- | Change a given 'Producer' into a 'FileReader' 'Producer' with the
-- 'FileOrigin' set to 'Stdin'.
--
-- You can think of this function as having the following type:
--
-- @
--   'stdinProducerToFileReader'
--     :: 'Monad' m
--     => 'Producer' a m r
--     -> 'Producer' ('FileReader' a) m r
-- @
--
-- >>> Pipes.head . stdinProducerToFileReader $ yield "hello"
-- Just (FileReaderSuccess Stdin "hello")
stdinProducerToFileReader
  :: forall x' x a m r.
     Monad m
  => Proxy x' x () a m r
  -> Proxy x' x () (FileReader a) m r
stdinProducerToFileReader :: Proxy x' x () a m r -> Proxy x' x () (FileReader a) m r
stdinProducerToFileReader Proxy x' x () a m r
producer = Proxy x' x () a m r
producer Proxy x' x () a m r
-> Proxy () a () (FileReader a) m r
-> Proxy x' x () (FileReader a) m r
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> FileReader a) -> Proxy () a () (FileReader a) m r
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
Pipes.map a -> FileReader a
go
  where
    go :: a -> FileReader a
    go :: a -> FileReader a
go = FileOrigin -> a -> FileReader a
forall a. FileOrigin -> a -> FileReader a
FileReaderSuccess FileOrigin
Stdin
{-# INLINABLE stdinProducerToFileReader #-}

-- | Convert a 'Producer' of 'FileReader' 'Handle' into a 'Producer' of
-- 'FileReader' 'ByteString', where each line from the 'Handle' is 'yield'ed.
--
-- You can think of this function as having the following type:
--
-- @
--   'fileReaderHandleToLine'
--     :: 'MonadIO' m
--     => 'Producer' ('FileReader' 'Handle') m r
--     -> 'Producer' ('FileReader' 'ByteString') m r
-- @
--
-- >>> let fileOrigin = FileSpecifiedByUser "test/golden/test-files/file2"
-- >>> let producer = fileListProducer Recursive fileOrigin
-- >>> Pipes.head $ fileReaderHandleToLine producer
-- Just (FileReaderSuccess (FileSpecifiedByUser "test/golden/test-files/file2") "Pr...
fileReaderHandleToLine
  :: forall m x' x r.
     MonadIO m
  => Proxy x' x () (FileReader Handle) m r
  -> Proxy x' x () (FileReader ByteString) m r
fileReaderHandleToLine :: Proxy x' x () (FileReader Handle) m r
-> Proxy x' x () (FileReader ByteString) m r
fileReaderHandleToLine Proxy x' x () (FileReader Handle) m r
producer = Proxy x' x () (FileReader Handle) m r
producer Proxy x' x () (FileReader Handle) m r
-> Proxy () (FileReader Handle) () (FileReader ByteString) m r
-> Proxy x' x () (FileReader ByteString) m r
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy () (FileReader Handle) () (FileReader ByteString) m r
pipe
  where
    pipe :: Pipe (FileReader Handle) (FileReader ByteString) m r
    pipe :: Proxy () (FileReader Handle) () (FileReader ByteString) m r
pipe = do
      FileReader Handle
fileReaderHandle <- Proxy
  ()
  (FileReader Handle)
  ()
  (FileReader ByteString)
  m
  (FileReader Handle)
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
      case FileReader Handle
fileReaderHandle of
        FileReaderErr FileOrigin
fileOrigin IOException
fileErr Maybe IOException
dirErr ->
          FileReader ByteString
-> Proxy () (FileReader Handle) () (FileReader ByteString) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (FileReader ByteString
 -> Proxy () (FileReader Handle) () (FileReader ByteString) m ())
-> FileReader ByteString
-> Proxy () (FileReader Handle) () (FileReader ByteString) m ()
forall a b. (a -> b) -> a -> b
$ FileOrigin
-> IOException -> Maybe IOException -> FileReader ByteString
forall a.
FileOrigin -> IOException -> Maybe IOException -> FileReader a
FileReaderErr FileOrigin
fileOrigin IOException
fileErr Maybe IOException
dirErr
        FileReaderSuccess FileOrigin
fileOrigin Handle
handle -> do
          let linesProducer :: Proxy x' x () ByteString m ()
linesProducer = Handle -> Producer' ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Handle -> Producer' ByteString m ()
fromHandleLines Handle
handle
          Proxy () (FileReader Handle) () ByteString m ()
Producer' ByteString m ()
linesProducer Proxy () (FileReader Handle) () ByteString m ()
-> Proxy () ByteString () (FileReader ByteString) m ()
-> Proxy () (FileReader Handle) () (FileReader ByteString) m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (ByteString -> FileReader ByteString)
-> Proxy () ByteString () (FileReader ByteString) m ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
Pipes.map (FileOrigin -> ByteString -> FileReader ByteString
forall a. FileOrigin -> a -> FileReader a
FileReaderSuccess FileOrigin
fileOrigin)
      Proxy () (FileReader Handle) () (FileReader ByteString) m r
pipe

-- | Create a 'Producer' of 'FileReader' 'Handle' for a given 'FileOrigin'.
--
-- Setup for examples:
--
-- >>> import Highlight.Common.Options (Recursive(NotRecursive, Recursive))
--
-- If 'NoRecursive' is specified, just try to read 'FileOrigin' as a file.
--
-- >>> let fileOrigin1 = FileSpecifiedByUser "test/golden/test-files/file2"
-- >>> toListM $ fileListProducer NotRecursive fileOrigin1
-- [FileReaderSuccess (FileSpecifiedByUser "test/.../file2") {handle: test/.../file2}]
--
-- If the file cannot be read, return an error.
--
-- >>> let fileOrigin2 = FileSpecifiedByUser "thisfiledoesnotexist"
-- >>> toListM $ fileListProducer NotRecursive fileOrigin2
-- [FileReaderErr (FileSpecifiedByUser "thisfiledoesnotexist") thisfiledoesnotexist: openBinaryFile: does not exist (No such file or directory) Nothing]
--
-- If 'Recursive' is specified, then try to read 'FileOrigin' as a directory'.
--
-- >>> let fileOrigin3 = FileSpecifiedByUser "test/golden/test-files/dir2"
-- >>> toListM $ fileListProducer Recursive fileOrigin3
-- [FileReaderSuccess (FileFoundRecursively "test/.../dir2/file6") {handle: test/.../dir2/file6}]
--
-- If the directory cannot be read, return an error.
--
-- >>> let fileOrigin4 = FileSpecifiedByUser "thisdirdoesnotexist"
-- >>> toListM $ fileListProducer Recursive fileOrigin4
-- [FileReaderErr (FileSpecifiedByUser "thisdirdoesnotexist") thisdirdoesnotexist: openBinaryFile: does not exist (No such file or directory) (Just ...)]
fileListProducer
  :: forall x' x m.
     MonadIO m
  => Recursive
  -> FileOrigin
  -- -> Producer' (FileReader Handle) m ()
  -> Proxy x' x () (FileReader Handle) m ()
fileListProducer :: Recursive -> FileOrigin -> Proxy x' x () (FileReader Handle) m ()
fileListProducer Recursive
recursive = FileOrigin -> Proxy x' x () (FileReader Handle) m ()
go
  where
    go
      :: FileOrigin
      -- -> Producer' (FileReader Handle) m ()
      -> Proxy x' x () (FileReader Handle) m ()
    go :: FileOrigin -> Proxy x' x () (FileReader Handle) m ()
go FileOrigin
fileOrigin = do
      let maybeFilePath :: Maybe String
maybeFilePath = FileOrigin -> Maybe String
getFilePathFromFileOrigin FileOrigin
fileOrigin
      case Maybe String
maybeFilePath of
        -- This is standard input.  We don't currently handle this, so just
        -- return unit.
        Maybe String
Nothing -> () -> Proxy x' x () (FileReader Handle) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- This is a normal file.  Not standard input.
        Just String
filePath -> do
          Either IOException Handle
eitherHandle <- String
-> Proxy x' x () (FileReader Handle) m (Either IOException Handle)
forall (m :: * -> *).
MonadIO m =>
String -> m (Either IOException Handle)
openFilePathForReading String
filePath
          case Either IOException Handle
eitherHandle of
            Right Handle
handle -> FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (FileReader Handle -> Proxy x' x () (FileReader Handle) m ())
-> FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall a b. (a -> b) -> a -> b
$ FileOrigin -> Handle -> FileReader Handle
forall a. FileOrigin -> a -> FileReader a
FileReaderSuccess FileOrigin
fileOrigin Handle
handle
            Left IOException
fileIOErr ->
              if Recursive
recursive Recursive -> Recursive -> Bool
forall a. Eq a => a -> a -> Bool
== Recursive
Recursive
                then do
                  let fileListM :: IO [String]
fileListM = Producer String IO () -> IO [String]
forall (m :: * -> *) a. Monad m => Producer a m () -> m [a]
toListM (Producer String IO () -> IO [String])
-> Producer String IO () -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> Producer' String IO ()
forall (m :: * -> *). MonadIO m => String -> Producer' String m ()
childOf String
filePath
                  Either IOException [String]
eitherFileList <- IO (Either IOException [String])
-> Proxy
     x' x () (FileReader Handle) m (Either IOException [String])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException [String])
 -> Proxy
      x' x () (FileReader Handle) m (Either IOException [String]))
-> IO (Either IOException [String])
-> Proxy
     x' x () (FileReader Handle) m (Either IOException [String])
forall a b. (a -> b) -> a -> b
$ IO [String] -> IO (Either IOException [String])
forall e a. Exception e => IO a -> IO (Either e a)
try IO [String]
fileListM
                  case Either IOException [String]
eitherFileList of
                    Left IOException
dirIOErr ->
                      FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (FileReader Handle -> Proxy x' x () (FileReader Handle) m ())
-> FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall a b. (a -> b) -> a -> b
$
                        FileOrigin -> IOException -> Maybe IOException -> FileReader Handle
forall a.
FileOrigin -> IOException -> Maybe IOException -> FileReader a
FileReaderErr FileOrigin
fileOrigin IOException
fileIOErr (IOException -> Maybe IOException
forall a. a -> Maybe a
Just IOException
dirIOErr)
                    Right [String]
fileList -> do
                      let sortedFileList :: [String]
sortedFileList = [String] -> [String]
forall a. Ord a => [a] -> [a]
sort [String]
fileList
                      let fileOrigins :: [FileOrigin]
fileOrigins = (String -> FileOrigin) -> [String] -> [FileOrigin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> FileOrigin
FileFoundRecursively [String]
sortedFileList
                      let lalas :: [Proxy x' x () (FileReader Handle) m ()]
lalas =
                            (FileOrigin -> Proxy x' x () (FileReader Handle) m ())
-> [FileOrigin] -> [Proxy x' x () (FileReader Handle) m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                              (Recursive -> FileOrigin -> Proxy x' x () (FileReader Handle) m ()
forall x' x (m :: * -> *).
MonadIO m =>
Recursive -> FileOrigin -> Proxy x' x () (FileReader Handle) m ()
fileListProducer Recursive
recursive)
                              [FileOrigin]
fileOrigins
                      Proxy x' x () (Proxy x' x () (FileReader Handle) m ()) m ()
-> (Proxy x' x () (FileReader Handle) m ()
    -> Proxy x' x () (FileReader Handle) m ())
-> Proxy x' x () (FileReader Handle) m ()
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for ([Proxy x' x () (FileReader Handle) m ()]
-> Proxy x' x () (Proxy x' x () (FileReader Handle) m ()) m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each [Proxy x' x () (FileReader Handle) m ()]
forall x' x. [Proxy x' x () (FileReader Handle) m ()]
lalas) Proxy x' x () (FileReader Handle) m ()
-> Proxy x' x () (FileReader Handle) m ()
forall a. a -> a
id
                else
                  FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (FileReader Handle -> Proxy x' x () (FileReader Handle) m ())
-> FileReader Handle -> Proxy x' x () (FileReader Handle) m ()
forall a b. (a -> b) -> a -> b
$ FileOrigin -> IOException -> Maybe IOException -> FileReader Handle
forall a.
FileOrigin -> IOException -> Maybe IOException -> FileReader a
FileReaderErr FileOrigin
fileOrigin IOException
fileIOErr Maybe IOException
forall a. Maybe a
Nothing

-----------------------
-- Filename Handling --
-----------------------

-- | This data type specifies how printing filenames will be handled, along
-- with the 'computeFilenameHandlingFromFiles' function.
data FilenameHandlingFromFiles
  = NoFilename -- ^ Do not print the filename on stdout.
  | PrintFilename -- ^ Print the filename on stdout.
  deriving (FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool
(FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool)
-> (FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool)
-> Eq FilenameHandlingFromFiles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool
$c/= :: FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool
== :: FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool
$c== :: FilenameHandlingFromFiles -> FilenameHandlingFromFiles -> Bool
Eq, ReadPrec [FilenameHandlingFromFiles]
ReadPrec FilenameHandlingFromFiles
Int -> ReadS FilenameHandlingFromFiles
ReadS [FilenameHandlingFromFiles]
(Int -> ReadS FilenameHandlingFromFiles)
-> ReadS [FilenameHandlingFromFiles]
-> ReadPrec FilenameHandlingFromFiles
-> ReadPrec [FilenameHandlingFromFiles]
-> Read FilenameHandlingFromFiles
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilenameHandlingFromFiles]
$creadListPrec :: ReadPrec [FilenameHandlingFromFiles]
readPrec :: ReadPrec FilenameHandlingFromFiles
$creadPrec :: ReadPrec FilenameHandlingFromFiles
readList :: ReadS [FilenameHandlingFromFiles]
$creadList :: ReadS [FilenameHandlingFromFiles]
readsPrec :: Int -> ReadS FilenameHandlingFromFiles
$creadsPrec :: Int -> ReadS FilenameHandlingFromFiles
Read, Int -> FilenameHandlingFromFiles -> ShowS
[FilenameHandlingFromFiles] -> ShowS
FilenameHandlingFromFiles -> String
(Int -> FilenameHandlingFromFiles -> ShowS)
-> (FilenameHandlingFromFiles -> String)
-> ([FilenameHandlingFromFiles] -> ShowS)
-> Show FilenameHandlingFromFiles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilenameHandlingFromFiles] -> ShowS
$cshowList :: [FilenameHandlingFromFiles] -> ShowS
show :: FilenameHandlingFromFiles -> String
$cshow :: FilenameHandlingFromFiles -> String
showsPrec :: Int -> FilenameHandlingFromFiles -> ShowS
$cshowsPrec :: Int -> FilenameHandlingFromFiles -> ShowS
Show)

-- | Given a 'Producer' of 'FileReader's, figure out whether or not we should
-- print the filename of the file to stdout.
--
-- The following examples walk through possible command lines using @highlight@, and the corresponding return values of this function.
--
-- @
--   $ highlight expression
-- @
--
-- We want to read from stdin.  There should be no 'FileReaders' in the
-- 'Producer'. Do not print the filename.
--
-- >>> let producerStdin = each []
-- >>> (fhStdin, _) <- computeFilenameHandlingFromFiles producerStdin
-- >>> fhStdin
-- NoFilename
--
-- @
--   $ highlight expression file1
-- @
--
-- We want to highlight a single file.  There should only be a single
-- 'FileReader' in the 'Producer', and it should be 'FileSpecifiedByUser'.  Do
-- not print the filename.
--
-- >>> let fileOriginSingleFile = FileSpecifiedByUser "file1"
-- >>> let fileReaderSingleFile = FileReaderSuccess fileOriginSingleFile "hello"
-- >>> let producerSingleFile = each [fileReaderSingleFile]
-- >>> (fhSingleFile, _) <- computeFilenameHandlingFromFiles producerSingleFile
-- >>> fhSingleFile
-- NoFilename
--
-- @
--   $ highlight expression file1 file2
-- @
--
-- We want to highlight two files.  Print the filename.
--
-- >>> let fileOriginMulti1 = FileSpecifiedByUser "file1"
-- >>> let fileReaderMulti1 = FileReaderSuccess fileOriginMulti1 "hello"
-- >>> let fileOriginMulti2 = FileSpecifiedByUser "file2"
-- >>> let fileReaderMulti2 = FileReaderSuccess fileOriginMulti2 "bye"
-- >>> let producerMultiFile = each [fileReaderMulti1, fileReaderMulti2]
-- >>> (fhMultiFile, _) <- computeFilenameHandlingFromFiles producerMultiFile
-- >>> fhMultiFile
-- PrintFilename
--
-- @
--   $ highlight -r expression dir1
-- @
--
-- We want to highlight all files found in @dir1\/@.  Print filenames.
--
-- >>> let fileOriginRec = FileFoundRecursively "dir1/file1"
-- >>> let fileReaderRec = FileReaderSuccess fileOriginRec "cat"
-- >>> let producerRec = each [fileReaderRec]
-- >>> (fhRec, _) <- computeFilenameHandlingFromFiles producerRec
-- >>> fhRec
-- PrintFilename
computeFilenameHandlingFromFiles
  :: forall a m r.
     Monad m
  => Producer (FileReader a) m r
  -> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
computeFilenameHandlingFromFiles :: Producer (FileReader a) m r
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
computeFilenameHandlingFromFiles Producer (FileReader a) m r
producer1 = do
  Either r (FileReader a, Producer (FileReader a) m r)
eitherFileReader1 <- Producer (FileReader a) m r
-> m (Either r (FileReader a, Producer (FileReader a) m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer (FileReader a) m r
producer1
  case Either r (FileReader a, Producer (FileReader a) m r)
eitherFileReader1 of
    Left r
ret ->
      (FilenameHandlingFromFiles, Producer (FileReader a) m r)
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilenameHandlingFromFiles
NoFilename, r -> Producer (FileReader a) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
ret)
    Right (FileReader a
fileReader1, Producer (FileReader a) m r
producer2) -> do
      let fileOrigin1 :: FileOrigin
fileOrigin1 = FileReader a -> FileOrigin
forall a. FileReader a -> FileOrigin
getFileOriginFromFileReader FileReader a
fileReader1
      case FileOrigin
fileOrigin1 of
        FileOrigin
Stdin -> String
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
forall a. HasCallStack => String -> a
error String
"Not currenty handling stdin..."
        FileSpecifiedByUser String
_ -> do
          Either r (FileReader a, Producer (FileReader a) m r)
eitherSecondFile <- Producer (FileReader a) m r
-> m (Either r (FileReader a, Producer (FileReader a) m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer (FileReader a) m r
producer2
          case Either r (FileReader a, Producer (FileReader a) m r)
eitherSecondFile of
            Left r
ret2 ->
              (FilenameHandlingFromFiles, Producer (FileReader a) m r)
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilenameHandlingFromFiles
NoFilename, FileReader a -> Proxy X () () (FileReader a) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield FileReader a
fileReader1 Proxy X () () (FileReader a) m ()
-> Producer (FileReader a) m r -> Producer (FileReader a) m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> Producer (FileReader a) m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
ret2)
            Right (FileReader a
fileReader2, Producer (FileReader a) m r
producer3) ->
              (FilenameHandlingFromFiles, Producer (FileReader a) m r)
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return
                ( FilenameHandlingFromFiles
PrintFilename
                , FileReader a -> Proxy X () () (FileReader a) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield FileReader a
fileReader1 Proxy X () () (FileReader a) m ()
-> Proxy X () () (FileReader a) m ()
-> Proxy X () () (FileReader a) m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FileReader a -> Proxy X () () (FileReader a) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield FileReader a
fileReader2 Proxy X () () (FileReader a) m ()
-> Producer (FileReader a) m r -> Producer (FileReader a) m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Producer (FileReader a) m r
producer3
                )
        FileFoundRecursively String
_ ->
          (FilenameHandlingFromFiles, Producer (FileReader a) m r)
-> m (FilenameHandlingFromFiles, Producer (FileReader a) m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilenameHandlingFromFiles
PrintFilename, FileReader a -> Proxy X () () (FileReader a) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield FileReader a
fileReader1 Proxy X () () (FileReader a) m ()
-> Producer (FileReader a) m r -> Producer (FileReader a) m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Producer (FileReader a) m r
producer2)