CurryInfo: showflatcurry-3.0.0 / ShowFlatCurry

------------------------------------------------------------------------------
--- This module contains various operations to show a FlatCurry program
--- in human-readable forms, e.g., only the interface or also the
--- complete program translated back into pattern-based rules.
--- These operations are used in the Curry Browser and they are
--- also the basis to implement the `:interface` command
--- of PAKCS or KiCS2.
---
--- The interface description contains the type declarations
--- for all entities defined and exported by this module.
---
--- The human-readable presentation is (almost) Curry source code
--- generated from a FlatCurry program.
---
--- @author Michael Hanus
--- @version April 2021
------------------------------------------------------------------------------

ShowFlatCurry

genCurryMod genInt getFlatInt getFlatProg main printCurryMod printInterface printUsage writeCurryMod writeInterface

module ShowFlatCurry where

import System.Environment ( getArgs )

import FlatCurry.Types
import FlatCurry.Files
import System.Directory   ( doesFileExist, getModificationTime )
import System.FilePath    ( takeFileName, (</>) )
import System.Process     ( exitWith )
import System.CurryPath   ( lookupModuleSourceInLoadPath, runModuleAction )

import FlatCurry.ShowIntMod

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

main :: IO ()
main = do
  args <- getArgs
  case args of
    [st,prog]        -> showProg st prog
    [st,prog,target] -> saveProg st prog target
    _                -> printUsage args
 where
  showProg st prog 
    | st `elem` ["-i", "-int", "--interface"]
    = runModuleAction printInterface prog
    | st `elem` ["-m", "-mod", "--module"]
    = runModuleAction printCurryMod prog
    | otherwise
    = printUsage [st, prog]

  saveProg st prog target
    | st `elem` ["-i", "-int", "--interface"]
    = runModuleAction (writeInterface target) prog
    | st `elem` ["-m", "-mod", "--module"]
    = runModuleAction (writeCurryMod target) prog
    | otherwise
    = printUsage [st, prog, target]

printUsage :: [String] -> IO ()
printUsage args = do
  putStrLn $ unlines $
    [ "ERROR: Illegal arguments: " ++ unwords args, ""
    , "Usage:", ""
    , "Print/store interface of a Curry module:", ""
    , "    curry-showflat [-i|--interface] modulename [targetfile]", ""
    , "Print/store Curry module reconstructed from the FlatCurry program:", ""
    , "    curry-showflat [-m|--module] modulename [targetfile]"
    ]
  exitWith 1

------------------------------------------------------------------------------
-- Print interface on stdout.
printInterface :: String -> IO ()
printInterface progname = do
  intstring <- genInt False progname
  putStrLn ("Interface of module \"" ++ progname ++ "\":\n")
  putStrLn intstring

-- Write interface into target file.
writeInterface :: String -> String -> IO ()
writeInterface targetfile progname = do
  intstring <- genInt True progname
  writeFile targetfile
            ("--Interface of module \"" ++ progname ++ "\":\n\n" ++
             intstring)
  putStrLn $ "Interface written into file \"" ++ targetfile ++ "\""

-- Generate interface description for a program:
-- If first argument is True, generate stubs (...external) for
-- all functions so that the resulting interface is a valid Curry program.
genInt :: Bool -> String -> IO String
genInt genstub progname =
  getFlatInt progname >>= return . showInterface genstub

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

-- show representation on stdout:
printCurryMod :: String -> IO ()
printCurryMod progname = do
  modstring <- genCurryMod progname
  putStrLn ("-- Program file: " ++ progname)
  putStrLn modstring

-- write representation into file:
writeCurryMod :: String -> String -> IO ()
writeCurryMod targetfile progname = do
  modstring <- genCurryMod progname
  writeFile targetfile
            ("--Program file: " ++ progname ++ "\n\n" ++
             modstring)
  putStrLn $ "Module written into file \"" ++ targetfile ++ "\""

-- generate a human-readable representation of a Curry module:
genCurryMod :: String -> IO String
genCurryMod modname = do
  --prog <- readFlatCurryFile (flatCurryFileName modname)
  prog <- getFlatProg modname
  return $ showCurryModule prog

------------------------------------------------------------------------------
-- Auxiliaries:

-- Get a FlatCurry program (parse only if necessary):
getFlatProg :: String -> IO Prog
getFlatProg modname = do
  mbdirfn <- lookupModuleSourceInLoadPath modname
  let progname    = maybe modname snd mbdirfn
      fcyprogname = flatCurryFileName
                      (maybe modname
                             (\ (d,_) -> d </> takeFileName modname)
                             mbdirfn)
  fcyexists <- doesFileExist fcyprogname
  if not fcyexists
    then readFlatCurry modname
    else do ctime <- getModificationTime progname
            ftime <- getModificationTime fcyprogname
            if ctime > ftime
              then readFlatCurry modname
              else readFlatCurryFile fcyprogname

-- Get a FlatCurry interface (parse only if necessary):
getFlatInt :: String -> IO Prog
getFlatInt modname = do
  mbdirfn <- lookupModuleSourceInLoadPath modname
  let progname     = maybe modname snd mbdirfn
      fintprogname = flatCurryIntName
                       (maybe modname
                              (\ (d,_) -> d </> takeFileName modname)
                              mbdirfn)
  fintexists <- doesFileExist fintprogname
  if not fintexists
    then readFlatCurryInt modname
    else do ctime <- getModificationTime progname
            ftime <- getModificationTime fintprogname
            if ctime > ftime
              then readFlatCurryInt modname
              else readFlatCurryFile fintprogname

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

safe