{-# LANGUAGE LambdaCase #-}

-- | = Note on these parsers
--
-- Seperate parsers are provided for different Fortran versions. A few parsers
-- are provided for each version, offering built-in defaults or allowing you to
-- configure them yourself. They can be identified by their suffix:
--
--   * @parser@: all defaults (without mod files, default transformations)
--   * @parserWithModFiles@: select mod files, default transformations
--   * @parserWithTransforms@: without mod files, select transformations
--   * @parserWithModFilesWithTransforms@: select mod files, select transformations
--

module Language.Fortran.Parser.Any where

import Language.Fortran.AST
import Language.Fortran.Util.ModFile
import Language.Fortran.Version (FortranVersion(..), deduceFortranVersion)
import Language.Fortran.ParserMonad (ParseErrorSimple(..), fromParseResult)

import Language.Fortran.Parser.Fortran66 ( fortran66Parser, fortran66ParserWithModFiles )
import Language.Fortran.Parser.Fortran77 ( fortran77Parser, fortran77ParserWithModFiles
                                         , extended77Parser, extended77ParserWithModFiles
                                         , legacy77Parser, legacy77ParserWithModFiles )
import Language.Fortran.Parser.Fortran90 ( fortran90Parser, fortran90ParserWithModFiles )
import Language.Fortran.Parser.Fortran95 ( fortran95Parser, fortran95ParserWithModFiles )
import Language.Fortran.Parser.Fortran2003 ( fortran2003Parser, fortran2003ParserWithModFiles )

import qualified Data.ByteString.Char8 as B

type Parser = B.ByteString -> String -> Either ParseErrorSimple (ProgramFile A0)
parserVersions :: FortranVersion -> Parser
parserVersions :: FortranVersion -> Parser
parserVersions = \case
  FortranVersion
Fortran66         -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
fortran66Parser
  FortranVersion
Fortran77         -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
fortran77Parser
  FortranVersion
Fortran77Extended -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
extended77Parser
  FortranVersion
Fortran77Legacy   -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
legacy77Parser
  FortranVersion
Fortran90         -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
fortran90Parser
  FortranVersion
Fortran95         -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
fortran95Parser
  FortranVersion
Fortran2003       -> ParseResult AlexInput Token (ProgramFile A0)
-> Either ParseErrorSimple (ProgramFile A0)
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult AlexInput Token (ProgramFile A0)
 -> Either ParseErrorSimple (ProgramFile A0))
-> (ByteString
    -> String -> ParseResult AlexInput Token (ProgramFile A0))
-> Parser
forall b c t a. (b -> c) -> (t -> a -> b) -> t -> a -> c
`after` ByteString
-> String -> ParseResult AlexInput Token (ProgramFile A0)
fortran2003Parser
  FortranVersion
_                 -> String -> Parser
forall a. HasCallStack => String -> a
error String
"no parser available for requested Fortran version"
  where
    after :: (b -> c) -> (t -> a -> b) -> t -> a -> c
    after :: (b -> c) -> (t -> a -> b) -> t -> a -> c
after b -> c
g t -> a -> b
f t
x = b -> c
g (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> a -> b
f t
x

type ParserWithModFiles = ModFiles -> B.ByteString -> String -> Either ParseErrorSimple (ProgramFile A0)
parserWithModFilesVersions :: FortranVersion -> ParserWithModFiles
parserWithModFilesVersions :: FortranVersion -> ParserWithModFiles
parserWithModFilesVersions = \case
  FortranVersion
Fortran66         -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
fortran66ParserWithModFiles
  FortranVersion
Fortran77         -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
fortran77ParserWithModFiles
  FortranVersion
Fortran77Extended -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
extended77ParserWithModFiles
  FortranVersion
Fortran77Legacy   -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
legacy77ParserWithModFiles
  FortranVersion
Fortran90         -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
fortran90ParserWithModFiles
  FortranVersion
Fortran95         -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
fortran95ParserWithModFiles
  FortranVersion
Fortran2003       -> (ModFiles
 -> ByteString
 -> String
 -> ParseResult AlexInput Token (ProgramFile A0))
-> ParserWithModFiles
forall c t t a b a.
Show c =>
(t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper ModFiles
-> ByteString
-> String
-> ParseResult AlexInput Token (ProgramFile A0)
fortran2003ParserWithModFiles
  FortranVersion
_                 -> String -> ParserWithModFiles
forall a. HasCallStack => String -> a
error String
"no parser available for requested Fortran version"
  where
    helper :: (t -> t -> a -> ParseResult b c a)
-> t -> t -> a -> Either ParseErrorSimple a
helper t -> t -> a -> ParseResult b c a
parser t
m t
s = ParseResult b c a -> Either ParseErrorSimple a
forall c b a.
Show c =>
ParseResult b c a -> Either ParseErrorSimple a
fromParseResult (ParseResult b c a -> Either ParseErrorSimple a)
-> (a -> ParseResult b c a) -> a -> Either ParseErrorSimple a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> t -> a -> ParseResult b c a
parser t
m t
s

-- | Deduce the type of parser from the filename and parse the
-- contents of the file.
fortranParser :: Parser
fortranParser :: Parser
fortranParser ByteString
contents String
filename =
   let parserF :: Parser
parserF = FortranVersion -> Parser
parserVersions (String -> FortranVersion
deduceFortranVersion String
filename)
    in Parser
parserF ByteString
contents String
filename

-- | Deduce the type of parser from the filename and parse the
-- contents of the file, within the context of given "mod files".
fortranParserWithModFiles :: ParserWithModFiles
fortranParserWithModFiles :: ParserWithModFiles
fortranParserWithModFiles ModFiles
mods ByteString
contents String
filename =
   let parserF :: ParserWithModFiles
parserF = FortranVersion -> ParserWithModFiles
parserWithModFilesVersions (String -> FortranVersion
deduceFortranVersion String
filename)
    in ParserWithModFiles
parserF ModFiles
mods ByteString
contents String
filename

-- | Given a FortranVersion, parse the contents of the file.
fortranParserWithVersion :: FortranVersion -> Parser
fortranParserWithVersion :: FortranVersion -> Parser
fortranParserWithVersion FortranVersion
v ByteString
contents String
filename =
   let parserF :: Parser
parserF = FortranVersion -> Parser
parserVersions FortranVersion
v
    in Parser
parserF ByteString
contents String
filename

-- | Given a FortranVersion, parse the contents of the file, within
-- the context of given "mod files".
fortranParserWithModFilesAndVersion :: FortranVersion -> ParserWithModFiles
fortranParserWithModFilesAndVersion :: FortranVersion -> ParserWithModFiles
fortranParserWithModFilesAndVersion FortranVersion
v ModFiles
mods ByteString
contents String
filename =
   let parserF :: ParserWithModFiles
parserF = FortranVersion -> ParserWithModFiles
parserWithModFilesVersions FortranVersion
v
    in ParserWithModFiles
parserF ModFiles
mods ByteString
contents String
filename