1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
------------------------------------------------------------------------------
--- This library defines operations to read FlatCurry programs or interfaces
--- together with all its imported modules in the current load path.
---
--- @author Michael Hanus, Bjoern Peemoeller, Finn Teegen
--- @version November 2020
------------------------------------------------------------------------------

module FlatCurry.Read
  ( readFlatCurryInPath
  , readFlatCurryWithImports
  , readFlatCurryWithImportsInPath
  , readFlatCurryIntWithImports
  , readFlatCurryIntWithImportsInPath
  ) where

import Control.Monad       ( when )
import System.Directory    ( getModificationTime, getFileWithSuffix
                           , findFileWithSuffix )
import System.FilePath     ( dropExtension, normalise, takeFileName )
import System.CurryPath    ( getLoadPathForModule, lookupModuleSource )
import System.FrontendExec ( FrontendTarget (FCY), callFrontendWithParams
                           , defaultParams, setQuiet, setFullPath )

import FlatCurry.Types
import FlatCurry.Files

--- Reads a FlatCurry program together in a given load path.
--- The arguments are a load path and the name of the module.
readFlatCurryInPath :: [String] -> String -> IO Prog
readFlatCurryInPath loadpath modname = do
  [prog] <- readFlatCurryFileInPath False False loadpath modname [".fcy"]
  return prog

--- Reads a FlatCurry program together with all its imported modules.
--- The argument is the name of the main module,
--- possibly with a directory prefix.
readFlatCurryWithImports :: String -> IO [Prog]
readFlatCurryWithImports modname = do
  loadpath <- getLoadPathForModule modname
  readFlatCurryFileInPath True False loadpath (takeFileName modname) [".fcy"]

--- Reads a FlatCurry program together with all its imported modules
--- in a given load path.
--- The arguments are a load path and the name of the main module.
readFlatCurryWithImportsInPath :: [String] -> String -> IO [Prog]
readFlatCurryWithImportsInPath loadpath modname =
  readFlatCurryFileInPath True False loadpath modname [".fcy"]

--- Reads a FlatCurry interface together with all its imported module
--- interfaces.
--- The argument is the name of the main module,
--- possibly with a directory prefix.
--- If there is no interface file but a FlatCurry file (suffix ".fcy"),
--- the FlatCurry file is read instead of the interface.
readFlatCurryIntWithImports :: String -> IO [Prog]
readFlatCurryIntWithImports modname = do
  loadpath <- getLoadPathForModule modname
  readFlatCurryFileInPath True False loadpath (takeFileName modname)
                                     [".fint",".fcy"]

--- Reads a FlatCurry interface together with all its imported module
--- interfaces in a given load path.
--- The arguments are a load path and the name of the main module.
--- If there is no interface file but a FlatCurry file (suffix ".fcy"),
--- the FlatCurry file is read instead of the interface.
readFlatCurryIntWithImportsInPath :: [String] -> String -> IO [Prog]
readFlatCurryIntWithImportsInPath loadpath modname =
  readFlatCurryFileInPath True False loadpath modname [".fint",".fcy"]

-- Read a FlatCurry file (together with its imported modules if the first
-- argument is true).
-- The further arguments are the verbosity mode, the loadpath,
-- the name of the main module, and the possible suffixes
-- of the FlatCurry file (e.g., [".fint",".fcy"]).
readFlatCurryFileInPath :: Bool -> Bool -> [String] -> String -> [String]
                       -> IO [Prog]
readFlatCurryFileInPath withImp verb loadpath mod sfxs = do
  when verb $ putStr "Reading FlatCurry files "
  -- try to read the interface files directly
  eiMods <- tryReadFlatCurryFile withImp verb loadpath mod sfxs
  either (\_ -> parseFlatCurryFile withImp verb loadpath mod sfxs)
         return
         eiMods

-- Parse a FlatCurry file together with its imported modules.
-- The argument is the loadpath, the name of the main module, and the
-- possible suffixes of the FlatCurry file (e.g., [".fint",".fcy"]).
parseFlatCurryFile :: Bool -> Bool -> [String] -> String -> [String]
                   -> IO [Prog]
parseFlatCurryFile withImp verb loadpath modname suffixes = do
  when verb $
    putStrLn $ ">>>>> FlatCurry files not up-to-date, parsing module \""
                ++ modname ++ "\"..."
  callFrontendWithParams FCY
     (setQuiet True (setFullPath loadpath defaultParams)) modname
  when verb $ putStr "Reading FlatCurry files "
  eiMods <- tryReadFlatCurryFile withImp verb loadpath modname suffixes
  return (either (error . notFound) id eiMods)
 where notFound mods = "FlatCurry file not found for the following module(s): "
                         ++ unwords mods

-- Read a FlatCurry file (with all its imports if first argument is true).
-- If all files could be read,
-- then `Right progs` is returned, otherwise `Left mods` where `mods` is
-- the list of modules that could *not* be read.
tryReadFlatCurryFile :: Bool -> Bool -> [String] -> String -> [String]
                     -> IO (Either [String] [Prog])
tryReadFlatCurryFile withImp verb loadpath modname suffixes =
  if withImp
    then tryReadFlatCurryFileWithImports verb loadpath modname suffixes
    else do mProg <- tryReadFlatCurry verb loadpath modname suffixes
            return $ maybe (Left [modname]) (Right . (:[])) mProg

-- Read a FlatCurry file with all its imports. If all files could be read,
-- then `Right progs` is returned, otherwise `Left mods` where `mods` is
-- the list of modules that could *not* be read.
tryReadFlatCurryFileWithImports :: Bool -> [String] -> String -> [String]
                                -> IO (Either [String] [Prog])
tryReadFlatCurryFileWithImports verb loadpath modname suffixes =
  collect [modname] []
 where
  -- Collects all imported modules
  collect []         _       = when verb (putStrLn "done") >> return (Right [])
  collect (mod:mods) implist
    | mod `elem` implist     = collect mods implist
    | otherwise              = do
      mbProg <- tryReadFlatCurry verb loadpath mod suffixes
      case mbProg of
        Nothing                     -> return (Left [mod])
        Just prog@(Prog _ is _ _ _) -> do
          mbresults <- collect (mods ++ is) (mod:implist)
          return (either Left (Right . (prog :)) mbresults)

-- Read a single FlatCurry file for a module if it exists and is up-to-date
-- w.r.t. the source program. If no source exists, it is always assumed
-- to be up-to-date. If the source is newer then the FlatCurry file or
-- there is no FlatCurry file, the function returns `Nothing`.
tryReadFlatCurry :: Bool -> [String] -> String -> [String] -> IO (Maybe Prog)
tryReadFlatCurry verb loadpath modname suffixes = do
  mbSrc <- lookupModuleSource loadpath modname
  case mbSrc of
    Nothing -> findFileWithSuffix flattakeBaseName suffixes loadpath >>=
               maybe (return Nothing) (fmap Just  . readFlatCurryFile)
    Just (_,src) -> do
      mbFcy <- findFileWithSuffix flattakeBaseName suffixes loadpath
      case mbFcy of
        Nothing  -> return Nothing
        Just fcy -> do
          ctime <- getModificationTime src
          ftime <- getModificationTime fcy
          if ctime > ftime
            then return Nothing
            else do
              when verb $ putStr (normalise fcy ++ " ")
              fmap Just (readFlatCurryFile fcy)
 where flattakeBaseName = dropExtension (flatCurryFileName modname)