----------------------------------------------------------------------
-- |
-- Module      : ReadFiles
-- Maintainer  : AR
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/11/11 23:24:34 $ 
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.26 $
--
-- Decide what files to read as function of dependencies and time stamps.
--
-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
--
-- to find all files that have to be read, put them in dependency order, and
-- decide which files need recompilation. Name @file.gf@ is returned for them,
-- and @file.gfo@ otherwise.
-----------------------------------------------------------------------------

module GF.Compile.ReadFiles
           ( getAllFiles,ModName,ModEnv,importsOfModule,
             findFile,gfImports,gfoImports,VersionTagged(..),
             parseSource,getOptionsFromFile,getPragmas) where

import Prelude hiding (catch)
import GF.System.Catch
import GF.Infra.UseIO
import GF.Infra.Option
import GF.Infra.Ident
import GF.Data.Operations
import GF.Grammar.Lexer
import GF.Grammar.Parser
import GF.Grammar.Grammar
import GF.Grammar.Binary(VersionTagged(..),decodeModuleHeader)

import System.IO(mkTextEncoding)
import GF.Text.Coding(decodeUnicodeIO)

import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.ByteString.Char8 as BS

import Control.Monad
import Data.Maybe(isJust)
import Data.Char(isSpace)
import qualified Data.Map as Map
import Data.Time(UTCTime)
import GF.System.Directory(getModificationTime,doesFileExist,canonicalizePath)
import System.FilePath
import GF.Text.Pretty

type ModName = String
type ModEnv  = Map.Map ModName (UTCTime,[ModName])


-- | Returns a list of all files to be compiled in topological order i.e.
-- the low level (leaf) modules are first.
--getAllFiles :: (MonadIO m,ErrorMonad m) => Options -> [InitPath] -> ModEnv -> FileName -> m [FullPath]
getAllFiles :: Options
-> [FilePath]
-> Map FilePath (UTCTime, [FilePath])
-> FilePath
-> m [FilePath]
getAllFiles Options
opts [FilePath]
ps Map FilePath (UTCTime, [FilePath])
env FilePath
file = do
  -- read module headers from all files recursively
  [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds <- [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
forall a. [a] -> [a]
reverse ([(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
   FilePath)]
 -> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
      FilePath)])
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [FilePath]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (m :: * -> *).
(ErrorMonad m, MonadIO m) =>
[FilePath]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
get [] [] (FilePath -> FilePath
justModuleName FilePath
file)
  Options -> FilePath -> m ()
forall (f :: * -> *). Output f => Options -> FilePath -> f ()
putIfVerb Options
opts (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"all modules:" FilePath -> FilePath -> FilePath
+++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath
name | (FilePath
name,CompStatus
_,Maybe UTCTime
_,Bool
_,[FilePath]
_,FilePath
_) <- [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds]
  [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> m [FilePath]) -> [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
-> [FilePath]
forall (t :: * -> *) c e.
Foldable t =>
t (FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
paths [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds
  where
    -- construct list of paths to read
    paths :: t (FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
paths t (FilePath, CompStatus, c, Bool, e, FilePath)
ds = ((FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath])
-> t (FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
forall c e.
(FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
mkFile t (FilePath, CompStatus, c, Bool, e, FilePath)
ds
      where
        mkFile :: (FilePath, CompStatus, c, Bool, e, FilePath) -> [FilePath]
mkFile (FilePath
f,CompStatus
st,c
time,Bool
has_src,e
imps,FilePath
p) =
          case CompStatus
st of 
            CompStatus
CSComp             -> [FilePath
p FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
gfFile FilePath
f]
            CompStatus
CSRead | Bool
has_src   -> [Options -> FilePath -> FilePath
gf2gfo Options
opts (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
gfFile FilePath
f)]
                   | Bool
otherwise -> [FilePath
p FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
gfoFile FilePath
f]
            CompStatus
CSEnv              -> []

    -- | traverses the dependency graph and returns a topologicaly sorted
    -- list of ModuleInfo. An error is raised if there is circular dependency
 {- get :: [ModName]          -- ^ keeps the current path in the dependency graph to avoid cycles
        -> [ModuleInfo]       -- ^ a list of already traversed modules
        -> ModName            -- ^ the current module
        -> IOE [ModuleInfo]   -- ^ the final -}
    get :: [FilePath]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
get [FilePath]
trc [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds FilePath
name
      | FilePath
name FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
trc = FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (m :: * -> *) a. ErrorMonad m => FilePath -> m a
raise (FilePath
 -> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
        FilePath)])
-> FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall a b. (a -> b) -> a -> b
$ FilePath
"circular modules" FilePath -> FilePath -> FilePath
+++ [FilePath] -> FilePath
unwords [FilePath]
trc
      | (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [FilePath
n | (FilePath
n,CompStatus
_,Maybe UTCTime
_,Bool
_,[FilePath]
_,FilePath
_) <- [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds, FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
n]     --- file already read
                        = [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds
      | Bool
otherwise       = do
           (FilePath
name,CompStatus
st0,Maybe UTCTime
t0,Bool
has_src,[FilePath]
imps,FilePath
p) <- FilePath
-> m (FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
      FilePath)
forall (m :: * -> *).
(MonadIO m, ErrorMonad m) =>
FilePath
-> m (FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
      FilePath)
findModule FilePath
name
           [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds <- ([(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
   FilePath)]
 -> FilePath
 -> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
        FilePath)])
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> [FilePath]
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([FilePath]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> FilePath
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
get (FilePath
nameFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
trc)) [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds [FilePath]
imps
           let (CompStatus
st,Maybe UTCTime
t) | Bool
has_src Bool -> Bool -> Bool
&&
                        (Flags -> Recomp) -> Options -> Recomp
forall a. (Flags -> a) -> Options -> a
flag Flags -> Recomp
optRecomp Options
opts Recomp -> Recomp -> Bool
forall a. Eq a => a -> a -> Bool
== Recomp
RecompIfNewer Bool -> Bool -> Bool
&&
                        (Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [FilePath
f | (FilePath
f,CompStatus
st,Maybe UTCTime
t1,Bool
_,[FilePath]
_,FilePath
_) <- [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds, FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
f [FilePath]
imps Bool -> Bool -> Bool
&& (UTCTime -> UTCTime -> Bool)
-> Maybe UTCTime -> Maybe UTCTime -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Maybe UTCTime
t0 Maybe UTCTime
t1 Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True]
                                  = (CompStatus
CSComp,Maybe UTCTime
forall a. Maybe a
Nothing)
                      | Bool
otherwise = (CompStatus
st0,Maybe UTCTime
t0)
           [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
-> m [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
       FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath
name,CompStatus
st,Maybe UTCTime
t,Bool
has_src,[FilePath]
imps,FilePath
p)(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
-> [(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
     FilePath)]
forall a. a -> [a] -> [a]
:[(FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)]
ds)

    gfoDir :: Maybe FilePath
gfoDir = (Flags -> Maybe FilePath) -> Options -> Maybe FilePath
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe FilePath
optGFODir Options
opts

    -- searches for module in the search path and if it is found
    -- returns 'ModuleInfo'. It fails if there is no such module
  --findModule :: ModName -> IOE ModuleInfo
    findModule :: FilePath
-> m (FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
      FilePath)
findModule FilePath
name = do
      (FilePath
file,Maybe UTCTime
gfTime,Maybe UTCTime
gfoTime) <- Maybe FilePath
-> [FilePath]
-> FilePath
-> m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall (m :: * -> *).
(MonadIO m, ErrorMonad m) =>
Maybe FilePath
-> [FilePath]
-> FilePath
-> m (FilePath, Maybe UTCTime, Maybe UTCTime)
findFile Maybe FilePath
gfoDir [FilePath]
ps FilePath
name

      let mb_envmod :: Maybe (UTCTime, [FilePath])
mb_envmod = FilePath
-> Map FilePath (UTCTime, [FilePath])
-> Maybe (UTCTime, [FilePath])
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
name Map FilePath (UTCTime, [FilePath])
env
          (CompStatus
st,Maybe UTCTime
t) = Options
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> (CompStatus, Maybe UTCTime)
selectFormat Options
opts (((UTCTime, [FilePath]) -> UTCTime)
-> Maybe (UTCTime, [FilePath]) -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime, [FilePath]) -> UTCTime
forall a b. (a, b) -> a
fst Maybe (UTCTime, [FilePath])
mb_envmod) Maybe UTCTime
gfTime Maybe UTCTime
gfoTime

      (CompStatus
st,(FilePath
mname,[FilePath]
imps)) <-
          case CompStatus
st of
            CompStatus
CSEnv  -> (CompStatus, (FilePath, [FilePath]))
-> m (CompStatus, (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompStatus
st, (FilePath
name, [FilePath]
-> ((UTCTime, [FilePath]) -> [FilePath])
-> Maybe (UTCTime, [FilePath])
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (UTCTime, [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd Maybe (UTCTime, [FilePath])
mb_envmod))
            CompStatus
CSRead -> do let gfo :: FilePath
gfo = if FilePath -> Bool
isGFO FilePath
file then FilePath
file else Options -> FilePath -> FilePath
gf2gfo Options
opts FilePath
file
                         VersionTagged (FilePath, [FilePath])
t_imps <- FilePath -> m (VersionTagged (FilePath, [FilePath]))
forall (f :: * -> *).
MonadIO f =>
FilePath -> f (VersionTagged (FilePath, [FilePath]))
gfoImports FilePath
gfo
                         case VersionTagged (FilePath, [FilePath])
t_imps of
                           Tagged (FilePath, [FilePath])
imps -> (CompStatus, (FilePath, [FilePath]))
-> m (CompStatus, (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompStatus
st,(FilePath, [FilePath])
imps)
                           VersionTagged (FilePath, [FilePath])
WrongVersion
                             | FilePath -> Bool
isGFO FilePath
file -> FilePath -> m (CompStatus, (FilePath, [FilePath]))
forall (m :: * -> *) a. ErrorMonad m => FilePath -> m a
raise (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is compiled with different GF version and I can't find the source file")
                             | Bool
otherwise  -> do (FilePath, [FilePath])
imps <- Options -> FilePath -> m (FilePath, [FilePath])
forall (f :: * -> *).
(ErrorMonad f, MonadIO f) =>
Options -> FilePath -> f (FilePath, [FilePath])
gfImports Options
opts FilePath
file
                                                (CompStatus, (FilePath, [FilePath]))
-> m (CompStatus, (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompStatus
CSComp,(FilePath, [FilePath])
imps)
            CompStatus
CSComp -> do (FilePath, [FilePath])
imps <- Options -> FilePath -> m (FilePath, [FilePath])
forall (f :: * -> *).
(ErrorMonad f, MonadIO f) =>
Options -> FilePath -> f (FilePath, [FilePath])
gfImports Options
opts FilePath
file
                         (CompStatus, (FilePath, [FilePath]))
-> m (CompStatus, (FilePath, [FilePath]))
forall (m :: * -> *) a. Monad m => a -> m a
return (CompStatus
st,(FilePath, [FilePath])
imps)
      Bool -> FilePath -> m ()
forall (m :: * -> *). ErrorMonad m => Bool -> FilePath -> m ()
testErr (FilePath
mname FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name)
              (FilePath
"module name" FilePath -> FilePath -> FilePath
+++ FilePath
mname FilePath -> FilePath -> FilePath
+++ FilePath
"differs from file name" FilePath -> FilePath -> FilePath
+++ FilePath
name)
      (FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath], FilePath)
-> m (FilePath, CompStatus, Maybe UTCTime, Bool, [FilePath],
      FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
name,CompStatus
st,Maybe UTCTime
t,Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
gfTime,[FilePath]
imps,FilePath -> FilePath
dropFileName FilePath
file)
--------------------------------------------------------------------------------

findFile :: Maybe FilePath
-> [FilePath]
-> FilePath
-> m (FilePath, Maybe UTCTime, Maybe UTCTime)
findFile Maybe FilePath
gfoDir [FilePath]
ps FilePath
name =
    m (FilePath, Maybe UTCTime, Maybe UTCTime)
-> (FilePath -> m (FilePath, Maybe UTCTime, Maybe UTCTime))
-> Maybe FilePath
-> m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall a. m (FilePath, Maybe a, Maybe UTCTime)
noSource FilePath -> m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall (m :: * -> *).
MonadIO m =>
FilePath -> m (FilePath, Maybe UTCTime, Maybe UTCTime)
haveSource (Maybe FilePath -> m (FilePath, Maybe UTCTime, Maybe UTCTime))
-> m (Maybe FilePath) -> m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath] -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
MonadIO m =>
[FilePath] -> FilePath -> m (Maybe FilePath)
getFilePath [FilePath]
ps (FilePath -> FilePath
gfFile FilePath
name)
  where
    haveSource :: FilePath -> m (FilePath, Maybe UTCTime, Maybe UTCTime)
haveSource FilePath
gfFile =
      do UTCTime
gfTime  <- FilePath -> m UTCTime
forall (m :: * -> *). MonadIO m => FilePath -> m UTCTime
getModificationTime FilePath
gfFile
         Maybe UTCTime
mb_gfoTime <- IO UTCTime -> m (Maybe UTCTime)
forall (f :: * -> *) a. MonadIO f => IO a -> f (Maybe a)
maybeIO (IO UTCTime -> m (Maybe UTCTime))
-> IO UTCTime -> m (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO UTCTime
forall (m :: * -> *). MonadIO m => FilePath -> m UTCTime
getModificationTime (Maybe FilePath -> FilePath -> FilePath
gf2gfo' Maybe FilePath
gfoDir FilePath
gfFile)
         (FilePath, Maybe UTCTime, Maybe UTCTime)
-> m (FilePath, Maybe UTCTime, Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
gfFile, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
gfTime, Maybe UTCTime
mb_gfoTime)

    noSource :: m (FilePath, Maybe a, Maybe UTCTime)
noSource =
        m (FilePath, Maybe a, Maybe UTCTime)
-> (FilePath -> m (FilePath, Maybe a, Maybe UTCTime))
-> Maybe FilePath
-> m (FilePath, Maybe a, Maybe UTCTime)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (FilePath, Maybe a, Maybe UTCTime)
forall a. m a
noGFO FilePath -> m (FilePath, Maybe a, Maybe UTCTime)
forall (m :: * -> *) a.
MonadIO m =>
FilePath -> m (FilePath, Maybe a, Maybe UTCTime)
haveGFO (Maybe FilePath -> m (FilePath, Maybe a, Maybe UTCTime))
-> m (Maybe FilePath) -> m (FilePath, Maybe a, Maybe UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FilePath] -> FilePath -> m (Maybe FilePath)
forall (m :: * -> *).
MonadIO m =>
[FilePath] -> FilePath -> m (Maybe FilePath)
getFilePath [FilePath]
gfoPath (FilePath -> FilePath
gfoFile FilePath
name)
      where
        gfoPath :: [FilePath]
gfoPath = ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath] -> [FilePath])
-> Maybe FilePath
-> [FilePath]
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath] -> [FilePath]
forall a. a -> a
id (:) Maybe FilePath
gfoDir [FilePath]
ps

        haveGFO :: FilePath -> m (FilePath, Maybe a, Maybe UTCTime)
haveGFO FilePath
gfoFile =
          do UTCTime
gfoTime <- FilePath -> m UTCTime
forall (m :: * -> *). MonadIO m => FilePath -> m UTCTime
getModificationTime FilePath
gfoFile
             (FilePath, Maybe a, Maybe UTCTime)
-> m (FilePath, Maybe a, Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
gfoFile, Maybe a
forall a. Maybe a
Nothing, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
gfoTime)

        noGFO :: m a
noGFO = FilePath -> m a
forall (m :: * -> *) a. ErrorMonad m => FilePath -> m a
raise (Doc -> FilePath
forall a. Pretty a => a -> FilePath
render (FilePath
"File" FilePath -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath -> FilePath
gfFile FilePath
name Doc -> FilePath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> FilePath
"does not exist." Doc -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$
                               FilePath
"searched in:" FilePath -> Doc -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> [FilePath] -> Doc
forall a. Pretty a => [a] -> Doc
vcat [FilePath]
ps))

gfImports :: Options -> FilePath -> f (FilePath, [FilePath])
gfImports Options
opts FilePath
file = SourceModule -> (FilePath, [FilePath])
importsOfModule (SourceModule -> (FilePath, [FilePath]))
-> f SourceModule -> f (FilePath, [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Options -> FilePath -> f SourceModule
forall (m :: * -> *).
(ErrorMonad m, MonadIO m) =>
Options -> FilePath -> m SourceModule
parseModHeader Options
opts FilePath
file

gfoImports :: FilePath -> f (VersionTagged (FilePath, [FilePath]))
gfoImports FilePath
gfo = (SourceModule -> (FilePath, [FilePath]))
-> VersionTagged SourceModule
-> VersionTagged (FilePath, [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceModule -> (FilePath, [FilePath])
importsOfModule (VersionTagged SourceModule
 -> VersionTagged (FilePath, [FilePath]))
-> f (VersionTagged SourceModule)
-> f (VersionTagged (FilePath, [FilePath]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> f (VersionTagged SourceModule)
forall (io :: * -> *).
MonadIO io =>
FilePath -> io (VersionTagged SourceModule)
decodeModuleHeader FilePath
gfo

--------------------------------------------------------------------------------

-- From the given Options and the time stamps computes
-- whether the module have to be computed, read from .gfo or
-- the environment version have to be used
selectFormat :: Options -> Maybe UTCTime -> Maybe UTCTime -> Maybe UTCTime -> (CompStatus,Maybe UTCTime)
selectFormat :: Options
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> (CompStatus, Maybe UTCTime)
selectFormat Options
opts Maybe UTCTime
mtenv Maybe UTCTime
mtgf Maybe UTCTime
mtgfo =
  case (Maybe UTCTime
mtenv,Maybe UTCTime
mtgfo,Maybe UTCTime
mtgf) of
    (Maybe UTCTime
_,Maybe UTCTime
_,Just UTCTime
tgf)         | Bool
fromSrc  -> (CompStatus
CSComp,Maybe UTCTime
forall a. Maybe a
Nothing)
    (Just UTCTime
tenv,Maybe UTCTime
_,Maybe UTCTime
_)        | Bool
fromComp -> (CompStatus
CSEnv, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tenv)
    (Maybe UTCTime
_,Just UTCTime
tgfo,Maybe UTCTime
_)        | Bool
fromComp -> (CompStatus
CSRead,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tgfo)
    (Just UTCTime
tenv,Maybe UTCTime
_,Just UTCTime
tgf) | UTCTime
tenv UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
tgf -> (CompStatus
CSEnv, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tenv)
    (Maybe UTCTime
_,Just UTCTime
tgfo,Just UTCTime
tgf) | UTCTime
tgfo UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
tgf -> (CompStatus
CSRead,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tgfo)
    (Just UTCTime
tenv,Maybe UTCTime
_,Maybe UTCTime
Nothing) -> (CompStatus
CSEnv,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tenv) -- source does not exist
    (Maybe UTCTime
_,Just UTCTime
tgfo,Maybe UTCTime
Nothing) -> (CompStatus
CSRead,UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
tgfo)  -- source does not exist
    (Maybe UTCTime, Maybe UTCTime, Maybe UTCTime)
_ -> (CompStatus
CSComp,Maybe UTCTime
forall a. Maybe a
Nothing)
  where
    fromComp :: Bool
fromComp = (Flags -> Recomp) -> Options -> Recomp
forall a. (Flags -> a) -> Options -> a
flag Flags -> Recomp
optRecomp Options
opts Recomp -> Recomp -> Bool
forall a. Eq a => a -> a -> Bool
== Recomp
NeverRecomp
    fromSrc :: Bool
fromSrc  = (Flags -> Recomp) -> Options -> Recomp
forall a. (Flags -> a) -> Options -> a
flag Flags -> Recomp
optRecomp Options
opts Recomp -> Recomp -> Bool
forall a. Eq a => a -> a -> Bool
== Recomp
AlwaysRecomp


-- internal module dep information


data CompStatus =
   CSComp -- compile: read gf
 | CSRead -- read gfo
 | CSEnv  -- gfo is in env
  deriving CompStatus -> CompStatus -> Bool
(CompStatus -> CompStatus -> Bool)
-> (CompStatus -> CompStatus -> Bool) -> Eq CompStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompStatus -> CompStatus -> Bool
$c/= :: CompStatus -> CompStatus -> Bool
== :: CompStatus -> CompStatus -> Bool
$c== :: CompStatus -> CompStatus -> Bool
Eq

type ModuleInfo = (ModName,CompStatus,Maybe UTCTime,Bool,[ModName],InitPath)

importsOfModule :: SourceModule -> (ModName,[ModName])
importsOfModule :: SourceModule -> (FilePath, [FilePath])
importsOfModule (ModuleName
m,ModuleInfo
mi) = (ModuleName -> FilePath
modName ModuleName
m,ModuleInfo -> [FilePath] -> [FilePath]
depModInfo ModuleInfo
mi [])
  where
    depModInfo :: ModuleInfo -> [FilePath] -> [FilePath]
depModInfo ModuleInfo
mi =
      ModuleType -> [FilePath] -> [FilePath]
depModType (ModuleInfo -> ModuleType
mtype ModuleInfo
mi)  ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [(ModuleName, MInclude)] -> [FilePath] -> [FilePath]
forall (t :: * -> *) b.
Foldable t =>
t (ModuleName, b) -> [FilePath] -> [FilePath]
depExtends (ModuleInfo -> [(ModuleName, MInclude)]
mextend ModuleInfo
mi) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Maybe (ModuleName, MInclude, [(ModuleName, ModuleName)])
-> [FilePath] -> [FilePath]
forall (t :: * -> *) b.
Foldable t =>
Maybe (ModuleName, b, t (ModuleName, ModuleName))
-> [FilePath] -> [FilePath]
depWith    (ModuleInfo
-> Maybe (ModuleName, MInclude, [(ModuleName, ModuleName)])
mwith ModuleInfo
mi)  ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [ModuleName] -> [FilePath] -> [FilePath]
depExDeps  (ModuleInfo -> [ModuleName]
mexdeps ModuleInfo
mi)([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [OpenSpec] -> [FilePath] -> [FilePath]
forall (t :: * -> *).
Foldable t =>
t OpenSpec -> [FilePath] -> [FilePath]
depOpens   (ModuleInfo -> [OpenSpec]
mopens ModuleInfo
mi)

    depModType :: ModuleType -> [FilePath] -> [FilePath]
depModType (ModuleType
MTAbstract)       [FilePath]
xs = [FilePath]
xs
    depModType (ModuleType
MTResource)       [FilePath]
xs = [FilePath]
xs
    depModType (ModuleType
MTInterface)      [FilePath]
xs = [FilePath]
xs
    depModType (MTConcrete ModuleName
m2)    [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
m2FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs
    depModType (MTInstance (ModuleName
m2,MInclude
_))    [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
m2FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs

    depExtends :: t (ModuleName, b) -> [FilePath] -> [FilePath]
depExtends t (ModuleName, b)
es [FilePath]
xs = ((ModuleName, b) -> [FilePath] -> [FilePath])
-> [FilePath] -> t (ModuleName, b) -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleName, b) -> [FilePath] -> [FilePath]
forall b. (ModuleName, b) -> [FilePath] -> [FilePath]
depInclude [FilePath]
xs t (ModuleName, b)
es

    depWith :: Maybe (ModuleName, b, t (ModuleName, ModuleName))
-> [FilePath] -> [FilePath]
depWith (Just (ModuleName
m,b
_,t (ModuleName, ModuleName)
is)) [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
m FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: t (ModuleName, ModuleName) -> [FilePath] -> [FilePath]
forall (t :: * -> *).
Foldable t =>
t (ModuleName, ModuleName) -> [FilePath] -> [FilePath]
depInsts t (ModuleName, ModuleName)
is [FilePath]
xs
    depWith Maybe (ModuleName, b, t (ModuleName, ModuleName))
Nothing         [FilePath]
xs = [FilePath]
xs

    depExDeps :: [ModuleName] -> [FilePath] -> [FilePath]
depExDeps [ModuleName]
eds [FilePath]
xs = (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
modName [ModuleName]
eds [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
xs

    depOpens :: t OpenSpec -> [FilePath] -> [FilePath]
depOpens t OpenSpec
os [FilePath]
xs = (OpenSpec -> [FilePath] -> [FilePath])
-> [FilePath] -> t OpenSpec -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OpenSpec -> [FilePath] -> [FilePath]
depOpen [FilePath]
xs t OpenSpec
os

    depInsts :: t (ModuleName, ModuleName) -> [FilePath] -> [FilePath]
depInsts t (ModuleName, ModuleName)
is [FilePath]
xs = ((ModuleName, ModuleName) -> [FilePath] -> [FilePath])
-> [FilePath] -> t (ModuleName, ModuleName) -> [FilePath]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ModuleName, ModuleName) -> [FilePath] -> [FilePath]
depInst [FilePath]
xs t (ModuleName, ModuleName)
is

    depInclude :: (ModuleName, b) -> [FilePath] -> [FilePath]
depInclude (ModuleName
m,b
_) [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
mFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs

    depOpen :: OpenSpec -> [FilePath] -> [FilePath]
depOpen (OSimple ModuleName
n  ) [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
nFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs
    depOpen (OQualif ModuleName
_ ModuleName
n) [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
nFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs

    depInst :: (ModuleName, ModuleName) -> [FilePath] -> [FilePath]
depInst (ModuleName
m,ModuleName
n) [FilePath]
xs = ModuleName -> FilePath
modName ModuleName
mFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:ModuleName -> FilePath
modName ModuleName
nFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
xs

    modName :: ModuleName -> FilePath
modName (MN Ident
m) = Ident -> FilePath
showIdent Ident
m


parseModHeader :: Options -> FilePath -> m SourceModule
parseModHeader Options
opts FilePath
file =
  do --ePutStrLn file
     (Maybe FilePath
_,Either (Posn, FilePath) SourceModule
parsed) <- Options
-> P SourceModule
-> ByteString
-> m (Maybe FilePath, Either (Posn, FilePath) SourceModule)
forall (m :: * -> *) a.
(ErrorMonad m, MonadIO m) =>
Options
-> P a
-> ByteString
-> m (Maybe FilePath, Either (Posn, FilePath) a)
parseSource Options
opts P SourceModule
pModHeader (ByteString
 -> m (Maybe FilePath, Either (Posn, FilePath) SourceModule))
-> m ByteString
-> m (Maybe FilePath, Either (Posn, FilePath) SourceModule)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO ByteString
BS.readFile FilePath
file)
     case Either (Posn, FilePath) SourceModule
parsed of
       Right SourceModule
mo          -> SourceModule -> m SourceModule
forall (m :: * -> *) a. Monad m => a -> m a
return SourceModule
mo
       Left (Pn Int
l Int
c,FilePath
msg) ->
                  FilePath -> m SourceModule
forall (m :: * -> *) a. ErrorMonad m => FilePath -> m a
raise (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg)

parseSource :: Options
-> P a
-> ByteString
-> m (Maybe FilePath, Either (Posn, FilePath) a)
parseSource Options
opts P a
p ByteString
raw =
  do (Maybe FilePath
coding,ByteString
utf8) <- Options -> ByteString -> m (Maybe FilePath, ByteString)
forall (m :: * -> *).
(ErrorMonad m, MonadIO m) =>
Options -> ByteString -> m (Maybe FilePath, ByteString)
toUTF8 Options
opts ByteString
raw
     (Maybe FilePath, Either (Posn, FilePath) a)
-> m (Maybe FilePath, Either (Posn, FilePath) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
coding,P a -> ByteString -> Either (Posn, FilePath) a
forall a. P a -> ByteString -> Either (Posn, FilePath) a
runP P a
p ByteString
utf8)

toUTF8 :: Options -> ByteString -> m (Maybe FilePath, ByteString)
toUTF8 Options
opts0 ByteString
raw =
  do Options
opts <- ByteString -> m Options
forall (m :: * -> *). ErrorMonad m => ByteString -> m Options
getPragmas ByteString
raw
     let given :: Maybe FilePath
given = (Flags -> Maybe FilePath) -> Options -> Maybe FilePath
forall a. (Flags -> a) -> Options -> a
flag Flags -> Maybe FilePath
optEncoding Options
opts -- explicitly given encoding
         coding :: FilePath
coding = Options -> FilePath
getEncoding (Options -> FilePath) -> Options -> FilePath
forall a b. (a -> b) -> a -> b
$ Options
opts0 Options -> Options -> Options
`addOptions` Options
opts
     ByteString
utf8 <- if FilePath
codingFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"UTF-8"
             then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw
             else if FilePath
codingFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"CP1252" -- Latin1
                  then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString)
-> (FilePath -> ByteString) -> FilePath -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
UTF8.fromString (FilePath -> m ByteString) -> FilePath -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BS.unpack ByteString
raw -- faster
                  else do --ePutStrLn $ "toUTF8 from "++coding
                          FilePath -> ByteString -> m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> ByteString -> m ByteString
recodeToUTF8 FilePath
coding ByteString
raw
     (Maybe FilePath, ByteString) -> m (Maybe FilePath, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
given,ByteString
utf8)

recodeToUTF8 :: FilePath -> ByteString -> m ByteString
recodeToUTF8 FilePath
coding ByteString
raw =
  IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$
  do TextEncoding
enc <- FilePath -> IO TextEncoding
mkTextEncoding FilePath
coding
     -- decodeUnicodeIO uses a lot of stack space,
     -- so we need to split the file into smaller pieces
     [FilePath]
ls <- (ByteString -> IO FilePath) -> [ByteString] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TextEncoding -> ByteString -> IO FilePath
decodeUnicodeIO TextEncoding
enc) (ByteString -> [ByteString]
BS.lines ByteString
raw)
     ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
UTF8.fromString ([FilePath] -> FilePath
unlines [FilePath]
ls)

-- | options can be passed to the compiler by comments in @--#@, in the main file
--getOptionsFromFile :: (MonadIO m,ErrorMonad m) => FilePath -> m Options
getOptionsFromFile :: FilePath -> m Options
getOptionsFromFile FilePath
file = do
  Options
opts <- (IOError -> m Options)
-> (ByteString -> m Options)
-> Either IOError ByteString
-> m Options
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOError -> m Options
forall (m :: * -> *) p a. ErrorMonad m => p -> m a
failed ByteString -> m Options
forall (m :: * -> *). ErrorMonad m => ByteString -> m Options
getPragmas (Either IOError ByteString -> m Options)
-> m (Either IOError ByteString) -> m Options
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Either IOError ByteString) -> m (Either IOError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError ByteString) -> m (Either IOError ByteString))
-> IO (Either IOError ByteString) -> m (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO (Either IOError ByteString)
forall a. IO a -> IO (Either IOError a)
try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
file)
  -- The coding flag should not be inherited by other files
  Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> Options -> Options
addOptions Options
opts ((Flags -> Flags) -> Options
modifyFlags ((Flags -> Flags) -> Options) -> (Flags -> Flags) -> Options
forall a b. (a -> b) -> a -> b
$ \ Flags
f -> Flags
f{optEncoding :: Maybe FilePath
optEncoding=Maybe FilePath
forall a. Maybe a
Nothing}))
  where
    failed :: p -> m a
failed p
_ = FilePath -> m a
forall (m :: * -> *) a. ErrorMonad m => FilePath -> m a
raise (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ FilePath
"File " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist"


getPragmas :: (ErrorMonad m) => BS.ByteString -> m Options
getPragmas :: ByteString -> m Options
getPragmas = [FilePath] -> m Options
forall (err :: * -> *). ErrorMonad err => [FilePath] -> err Options
parseModuleOptions ([FilePath] -> m Options)
-> (ByteString -> [FilePath]) -> ByteString -> m Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
             (ByteString -> FilePath) -> [ByteString] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> FilePath
BS.unpack (ByteString -> FilePath)
-> (ByteString -> ByteString) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.unwords ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.words (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
3) ([ByteString] -> [FilePath])
-> (ByteString -> [ByteString]) -> ByteString -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
BS.isPrefixOf (FilePath -> ByteString
BS.pack FilePath
"--#")) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
--           takeWhile (BS.isPrefixOf (BS.pack "--")) .
--           filter (not . BS.null) .
             (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isSpace) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ByteString -> [ByteString]
BS.lines

getFilePath :: MonadIO m => [FilePath] -> String -> m (Maybe FilePath)
getFilePath :: [FilePath] -> FilePath -> m (Maybe FilePath)
getFilePath [FilePath]
paths FilePath
file = [FilePath] -> m (Maybe FilePath)
forall (m :: * -> *). MonadIO m => [FilePath] -> m (Maybe FilePath)
get [FilePath]
paths
  where
    get :: [FilePath] -> m (Maybe FilePath)
get []     = Maybe FilePath -> m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    get (FilePath
p:[FilePath]
ps) = do let pfile :: FilePath
pfile = FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
file
                    Bool
exist <- FilePath -> m Bool
forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist FilePath
pfile
                    if Bool -> Bool
not Bool
exist
                      then [FilePath] -> m (Maybe FilePath)
get [FilePath]
ps
                      else do FilePath
pfile <- FilePath -> m FilePath
forall (m :: * -> *). MonadIO m => FilePath -> m FilePath
canonicalizePath FilePath
pfile
                              Maybe FilePath -> m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
pfile)