-----------------------------------------------------------------------------
-- |
-- Module      :  ReadFirst
-- Copyright   :  2004 Malcolm Wallace
-- Licence     :  LGPL
-- 
-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability   :  experimental
-- Portability :  All
--
-- Read the first file that matches in a list of search paths.
-----------------------------------------------------------------------------

module Language.Preprocessor.Cpphs.ReadFirst
  ( readFirst
  , readFileUTF8
  , writeFileUTF8
  ) where

import System.IO
import System.Directory (doesFileExist)
import Data.List        (intersperse)
import Control.Exception as E
import Control.Monad    (when)
import Language.Preprocessor.Cpphs.Position  (Posn,directory,cleanPath)

-- | Attempt to read the given file from any location within the search path.
--   The first location found is returned, together with the file content.
--   (The directory of the calling file is always searched first, then
--    the current directory, finally any specified search path.)
readFirst :: String             -- ^ filename
        -> Posn                 -- ^ inclusion point
        -> [String]             -- ^ search path
        -> Bool                 -- ^ report warnings?
        -> IO ( FilePath
              , String
              )                 -- ^ discovered filepath, and file contents

readFirst :: String -> Posn -> [String] -> Bool -> IO (String, String)
readFirst String
name Posn
demand [String]
path Bool
warn =
    case String
name of
                       -- Windows drive in absolute path
       Char
c:Char
':':Char
'\\':String
nm-> String -> Maybe String -> [String] -> IO (String, String)
try String
nm   (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) [String
""]
       Char
c:Char
':':Char
'/':String
nm -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm   (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) [String
""]
                       -- Windows drive in relative path
       Char
c:Char
':':String
nm     -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm   (String -> Maybe String
forall a. a -> Maybe a
Just (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:[])) (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path))
                       -- unix-like absolute path
       Char
'/':String
nm       -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm   Maybe String
forall a. Maybe a
Nothing           [String
""]
                       -- any relative path
       String
_            -> String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
forall a. Maybe a
Nothing           (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path))
  where
    dd :: String
dd = Posn -> String
directory Posn
demand
    cons :: t a -> [t a] -> [t a]
cons t a
x [t a]
xs = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then [t a]
xs else t a
xt a -> [t a] -> [t a]
forall a. a -> [a] -> [a]
:[t a]
xs
    try :: String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
_ [] = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
warn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: Can't find file \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" in directories\n\t"
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n\t" (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd (String
"."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path)))
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n  Asked for by: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Posn -> String
forall a. Show a => a -> String
show Posn
demand)
        (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"missing file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name,String
"")
    try String
name Maybe String
drive (String
p:[String]
ps) = do
        let file :: String
file = ((String -> String)
-> (String -> String -> String) -> Maybe String -> String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id String -> String -> String
forall a. [a] -> [a] -> [a]
(++) Maybe String
drive) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
cleanPath String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
cleanPath String
name
        Bool
ok <- String -> IO Bool
doesFileExist String
file
        if Bool -> Bool
not Bool
ok then String -> Maybe String -> [String] -> IO (String, String)
try String
name Maybe String
drive [String]
ps
          else do String
content <- String -> IO String
readFileUTF8 String
file
                  (String, String) -> IO (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
file,String
content)

readFileUTF8 :: FilePath -> IO String
readFileUTF8 :: String -> IO String
readFileUTF8 String
file = do
    Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
ReadMode
    (do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding String
"UTF-8//ROUNDTRIP"
        Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8r
        Handle -> IO String
hGetContents Handle
h) IO String -> IO () -> IO String
forall a b. IO a -> IO b -> IO a
`E.onException` (Handle -> IO ()
hClose Handle
h)

writeFileUTF8 :: FilePath -> String -> IO ()
writeFileUTF8 :: String -> String -> IO ()
writeFileUTF8 String
f String
txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
f IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
hdl->
                          do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding String
"UTF-8//ROUNDTRIP"
                             Handle -> TextEncoding -> IO ()
hSetEncoding Handle
hdl TextEncoding
utf8r
                             Handle -> String -> IO ()
hPutStr Handle
hdl String
txt
                          IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`E.onException` (Handle -> IO ()
hClose Handle
hdl)