-- | This module exposes functions obtaining
-- 'Language.Fortran.AST.ProgramFile' from a valid file name.
module Language.Fortran.Extras.ProgramFile where

import qualified Data.ByteString.Char8      as B
import           Language.Fortran.AST       ( A0
                                            , ProgramFile
                                            )
import           Language.Fortran.Version   ( deduceFortranVersion
                                            , FortranVersion(..)
                                            )
import qualified Language.Fortran.Parser    as Parser
import           System.FilePath            ( takeDirectory )
import           Data.Either.Combinators    ( fromRight' )

-- | Obtain a 'ProgramFile' from a specific version of the parser with include
-- statements expanded.
--
-- TODO: cover all FortranVersions, instead of just Fortran77Legacy
versionedExpandedProgramFile
  :: FortranVersion -> [String] -> String -> B.ByteString -> IO (ProgramFile A0)
versionedExpandedProgramFile :: FortranVersion
-> [String] -> String -> ByteString -> IO (ProgramFile A0)
versionedExpandedProgramFile FortranVersion
v [String]
importDirs String
path ByteString
contents =
    case FortranVersion
v of
      FortranVersion
Fortran77Legacy ->
        [String] -> ModFiles -> String -> ByteString -> IO (ProgramFile A0)
Parser.f77lInlineIncludes (String -> String
takeDirectory String
path forall a. a -> [a] -> [a]
: [String]
importDirs) [] String
path ByteString
contents
      FortranVersion
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unsupported version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FortranVersion
v

-- | Obtain a 'ProgramFile' from a specific version of the parser.
versionedProgramFile
  :: FortranVersion -> String -> B.ByteString -> ProgramFile A0
versionedProgramFile :: FortranVersion -> String -> ByteString -> ProgramFile A0
versionedProgramFile FortranVersion
v String
p ByteString
c = forall a b. Either a b -> b
fromRight' forall a b. (a -> b) -> a -> b
$ (FortranVersion -> Parser (ProgramFile A0)
Parser.byVer FortranVersion
v) String
p ByteString
c

-- | Obtain a 'ProgramFile' from a parser version deduced by inspection
-- of the file extension.
--
-- For example "foo.f90" will deduce the 'Fortran90' Parser version.
programFile :: String -> B.ByteString -> ProgramFile A0
programFile :: String -> ByteString -> ProgramFile A0
programFile String
path ByteString
contents =
  let version :: FortranVersion
version = String -> FortranVersion
deduceFortranVersion String
path -- suggest version from file extension
  in  FortranVersion -> String -> ByteString -> ProgramFile A0
versionedProgramFile FortranVersion
version String
path ByteString
contents