-----------------------------------------------------------------------------
-- |
-- 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 name :: String
name demand :: Posn
demand path :: [String]
path warn :: Bool
warn =
    case String
name of
                       -- Windows drive in absolute path
       c :: Char
c:':':'\\':nm :: 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 -> String -> String
forall a. a -> [a] -> [a]
:[])) [""]
       c :: Char
c:':':'/':nm :: 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 -> String -> String
forall a. a -> [a] -> [a]
:[])) [""]
                       -- Windows drive in relative path
       c :: Char
c:':':nm :: 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 -> 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]
forall a. a -> [a] -> [a]
:[String]
path))
                       -- unix-like absolute path
       '/':nm :: String
nm       -> String -> Maybe String -> [String] -> IO (String, String)
try String
nm   Maybe String
forall a. Maybe a
Nothing           [""]
                       -- any relative path
       _            -> 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]
forall a. a -> [a] -> [a]
:[String]
path))
  where
    dd :: String
dd = Posn -> String
directory Posn
demand
    cons :: t a -> [t a] -> [t a]
cons x :: t a
x xs :: [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 name :: String
name _ [] = 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 ("Warning: Can't find file \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++"\" 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 "\n\t" (String -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [t a] -> [t a]
cons String
dd ("."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
path)))
                           String -> String -> String
forall a. [a] -> [a] -> [a]
++"\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 ("missing file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name,"")
    try name :: String
name drive :: Maybe String
drive (p :: String
p:ps :: [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 -> 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 file :: String
file = do
    Handle
h <- String -> IOMode -> IO Handle
openFile String
file IOMode
ReadMode
    (do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding "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 f :: String
f txt :: 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
$ \hdl :: Handle
hdl->
                          do TextEncoding
utf8r <- String -> IO TextEncoding
mkTextEncoding "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)