{-# Language FlexibleContexts, GADTs, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}

-- | The programming language Modula-2

module Language.Modula2 (parseModule, parseAndSimplifyModule, resolvePosition, resolvePositions,
                         Placed, Version(..), SomeVersion(..)) where

import qualified Language.Modula2.Abstract as Abstract
import qualified Language.Modula2.AST as Report (Language)
import qualified Language.Modula2.ISO.AST as ISO (Language)
import qualified Language.Modula2.Grammar as Grammar
import qualified Language.Modula2.ISO.Grammar as ISO.Grammar
import qualified Language.Modula2.ConstantFolder as ConstantFolder
import qualified Language.Modula2.ISO.ConstantFolder as ISO.ConstantFolder
import Language.Modula2.ConstantFolder (Sem, ConstantFold, InhCF, SynCFExp, SynCFMod')
import Language.Modula2.Pretty ()
import Language.Modula2.ISO.Pretty ()

import qualified Language.Oberon.Reserializer as Reserializer

import qualified Rank2 as Rank2 (snd)
import Transformation.AG (Atts, Inherited, Synthesized)
import Transformation.AG.Generics (Auto)
import qualified Transformation.Rank2 as Rank2
import qualified Transformation.Full as Full
import qualified Transformation.Deep as Deep

import Control.Arrow (first)
import Control.Monad (when)
import Data.Functor.Compose (Compose(Compose, getCompose))
import qualified Data.Map.Lazy as Map
import Data.Map.Lazy (Map)
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import Data.Text.IO (readFile)
import Text.Grampa (Ambiguous, Grammar, ParseResults, parseComplete, failureDescription)
import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive
import qualified Text.Parser.Input.Position as Position
import System.Directory (doesFileExist)
import System.FilePath (FilePath, addExtension, combine, takeDirectory)

import Prelude hiding (readFile)

-- | Every node in a parsed and resolved AST is wrapped with this functor
type Placed = (,) (Int, Grammar.ParsedLexemes, Int)

-- | The modes of operation
data Options = Options{
   -- | whether to fold the constants in the parsed module
   Options -> Bool
foldConstants :: Bool,
   -- whether to check the types
   -- checkTypes :: Bool,
   -- | which version of the Modula-2 language?
   Options -> SomeVersion
version :: SomeVersion}

data Version l where
   -- | the version specified by Niklaus Wirth's ''Report on the Programming Language Modula-2''
   Report :: Version Report.Language
   -- | the version specified by the ISO standard
   ISO    :: Version ISO.Language

-- | The language version in existential container
data SomeVersion where
   SomeVersion :: Version l -> SomeVersion

deriving instance Show (Version l)
deriving instance Show SomeVersion

-- | Replace the stored positions in the entire tree with offsets from the start of the given source text
resolvePositions :: (p ~ Grammar.NodeWrap, q ~ Placed, Deep.Functor (Rank2.Map p q) g)
                 => Text -> p (g p p) -> q (g q q)
resolvePositions :: Text -> p (g p p) -> q (g q q)
resolvePositions Text
src p (g p p)
t = Text -> NodeWrap (g q q) -> Placed (g q q)
forall a. Text -> NodeWrap a -> Placed a
resolvePosition Text
src ((Text -> NodeWrap a -> Placed a
forall a. Text -> NodeWrap a -> Placed a
resolvePosition Text
src (forall a. p a -> q a) -> g p p -> g q q
forall (p :: * -> *) (q :: * -> *)
       (g :: (* -> *) -> (* -> *) -> *).
Functor (Map p q) g =>
(forall a. p a -> q a) -> g p p -> g q q
Rank2.<$>) (g p p -> g q q) -> p (g p p) -> p (g q q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (g p p)
t)

-- | Replace the stored positions of the given node with offset from the start of the given source text
resolvePosition :: Text -> Grammar.NodeWrap a -> Placed a
resolvePosition :: Text -> NodeWrap a -> Placed a
resolvePosition Text
src = \((Position
start, ParsedLexemes
ws, Position
end), a
a)-> ((Text -> Position -> Int
forall s. FactorialMonoid s => s -> Position -> Int
Position.offset Text
src Position
start, ParsedLexemes
ws, Text -> Position -> Int
forall s. FactorialMonoid s => s -> Position -> Int
Position.offset Text
src Position
end), a
a)

-- | Parse the given text of a single module and fold constants inside it.
parseAndSimplifyModule :: (Abstract.Modula2 l, Abstract.Nameable l,
                           Full.Functor (Auto ConstantFold) (Abstract.Expression l l))
                    => Version l -> Text -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
parseAndSimplifyModule :: Version l
-> Text -> ParseResults Text [Placed (Module l l Placed Placed)]
parseAndSimplifyModule Version l
Report Text
source =
   (Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall (g :: (* -> *) -> (* -> *) -> *).
(Foldable (g (Const (Sum Int))),
 Foldable (Fold Placed (Sum Int)) g,
 Traversable PositionAdjustment g) =>
Parsed (g Placed Placed) -> Parsed (g Placed Placed)
Reserializer.adjustPositions (Parsed (Module Language Language Placed Placed)
 -> Parsed (Module Language Language Placed Placed))
-> (Parsed (Module Language Language Placed Placed)
    -> Parsed (Module Language Language Placed Placed))
-> Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Environment Language
-> Module Language Language Placed Placed
-> Module Language Language Placed Placed
forall l.
(Modula2 l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts (Inherited (Auto ConstantFold)) (Block l l Sem Sem) ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ InhCF l,
 Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Block l l Placed Placed)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ SynCFMod' l (Definition l l),
 Atts
   (Synthesized (Auto ConstantFold)) (Definition l l Placed Placed)
 ~ SynCFMod' l (Definition l l),
 Atts (Synthesized (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ SynCFExp l l,
 Atts
   (Synthesized (Auto ConstantFold)) (Expression l l Placed Placed)
 ~ SynCFExp l l,
 Functor (Auto ConstantFold) (Block l l),
 Functor (Auto ConstantFold) (Definition l l),
 Functor (Auto ConstantFold) (Expression l l)) =>
Environment l
-> Module l l Placed Placed -> Module l l Placed Placed
ConstantFolder.foldConstants (Version Language -> Environment Language
forall l.
(Modula2 l, Ord (QualIdent l)) =>
Version l -> Environment l
predefined Version Language
Report) (Module Language Language Placed Placed
 -> Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parsed (Module Language Language Placed Placed)
 -> Parsed (Module Language Language Placed Placed))
-> [Parsed (Module Language Language Placed Placed)]
-> [Parsed (Module Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
   ([Parsed (Module Language Language Placed Placed)]
 -> [Parsed (Module Language Language Placed Placed)])
-> Either
     (ParseFailure Text)
     [Parsed (Module Language Language Placed Placed)]
-> Either
     (ParseFailure Text)
     [Parsed (Module Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version Language
-> Text
-> ParseResults
     Text [Placed (Module Language Language Placed Placed)]
forall l.
Version l
-> Text -> ParseResults Text [Placed (Module l l Placed Placed)]
parseModule Version Language
Report Text
source
parseAndSimplifyModule Version l
ISO Text
source =
   (Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall (g :: (* -> *) -> (* -> *) -> *).
(Foldable (g (Const (Sum Int))),
 Foldable (Fold Placed (Sum Int)) g,
 Traversable PositionAdjustment g) =>
Parsed (g Placed Placed) -> Parsed (g Placed Placed)
Reserializer.adjustPositions (Parsed (Module Language Language Placed Placed)
 -> Parsed (Module Language Language Placed Placed))
-> (Parsed (Module Language Language Placed Placed)
    -> Parsed (Module Language Language Placed Placed))
-> Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Environment Language
-> Module Language Language Placed Placed
-> Module Language Language Placed Placed
forall l.
(Modula2 l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts (Inherited (Auto ConstantFold)) (Block l l Sem Sem) ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ InhCF l,
 Atts (Inherited (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ InhCF l,
 Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Block l l Placed Placed)
 ~ SynCFMod' l (Block l l),
 Atts (Synthesized (Auto ConstantFold)) (Definition l l Sem Sem)
 ~ SynCFMod' l (Definition l l),
 Atts
   (Synthesized (Auto ConstantFold)) (Definition l l Placed Placed)
 ~ SynCFMod' l (Definition l l),
 Atts (Synthesized (Auto ConstantFold)) (Expression l l Sem Sem)
 ~ SynCFExp l l,
 Atts
   (Synthesized (Auto ConstantFold)) (Expression l l Placed Placed)
 ~ SynCFExp l l,
 Functor (Auto ConstantFold) (Block l l),
 Functor (Auto ConstantFold) (Definition l l),
 Functor (Auto ConstantFold) (Expression l l)) =>
Environment l
-> Module l l Placed Placed -> Module l l Placed Placed
ISO.ConstantFolder.foldConstants (Version Language -> Environment Language
forall l.
(Modula2 l, Ord (QualIdent l)) =>
Version l -> Environment l
predefined Version Language
ISO) (Module Language Language Placed Placed
 -> Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
-> Parsed (Module Language Language Placed Placed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parsed (Module Language Language Placed Placed)
 -> Parsed (Module Language Language Placed Placed))
-> [Parsed (Module Language Language Placed Placed)]
-> [Parsed (Module Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
   ([Parsed (Module Language Language Placed Placed)]
 -> [Parsed (Module Language Language Placed Placed)])
-> Either
     (ParseFailure Text)
     [Parsed (Module Language Language Placed Placed)]
-> Either
     (ParseFailure Text)
     [Parsed (Module Language Language Placed Placed)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version Language
-> Text
-> ParseResults
     Text [Placed (Module Language Language Placed Placed)]
forall l.
Version l
-> Text -> ParseResults Text [Placed (Module l l Placed Placed)]
parseModule Version Language
ISO Text
source

-- | The predefined environment of types, constants, and procedures for the given language version.
predefined :: (Abstract.Modula2 l, Ord (Abstract.QualIdent l)) => Version l -> ConstantFolder.Environment l
predefined :: Version l -> Environment l
predefined Version l
Report = [(QualIdent Language,
  Maybe (Value Language Language Placed Placed))]
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(QualIdent Language,
   Maybe (Value Language Language Placed Placed))]
 -> Map
      (QualIdent Language)
      (Maybe (Value Language Language Placed Placed)))
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall a b. (a -> b) -> a -> b
$ ((Text, Maybe (Value Language Language Placed Placed))
 -> (QualIdent Language,
     Maybe (Value Language Language Placed Placed)))
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> QualIdent Language)
-> (Text, Maybe (Value Language Language Placed Placed))
-> (QualIdent Language,
    Maybe (Value Language Language Placed Placed))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> QualIdent Language
forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent) ([(Text, Maybe (Value Language Language Placed Placed))]
 -> [(QualIdent Language,
      Maybe (Value Language Language Placed Placed))])
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> a -> b
$
   [(Text
"TRUE", Value Language Language Placed Placed
-> Maybe (Value Language Language Placed Placed)
forall a. a -> Maybe a
Just Value Language Language Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true),
    (Text
"FALSE", Value Language Language Placed Placed
-> Maybe (Value Language Language Placed Placed)
forall a. a -> Maybe a
Just Value Language Language Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false)]
   [(Text, Maybe (Value Language Language Placed Placed))]
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(Text, Maybe (Value Language Language Placed Placed))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Text, Maybe (Value Language Language Placed Placed)))
-> [Text]
-> [(Text, Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Maybe (Value Language Language Placed Placed))
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Text -> (Text, Maybe (Value l l' f' f))
builtin [Text
"BITSET", Text
"BOOLEAN", Text
"CARDINAL", Text
"CHAR", Text
"INTEGER", Text
"PROC", Text
"REAL",
                   Text
"ABS", Text
"CAP", Text
"CHR", Text
"FLOAT", Text
"HIGH", Text
"MAX", Text
"MIN", Text
"ODD", Text
"ORD", Text
"TRUNC", Text
"VAL"]
   where builtin :: Text -> (Text, Maybe (Value l l' f' f))
builtin Text
name = (Text
name, Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just (Value l l' f' f -> Maybe (Value l l' f' f))
-> Value l l' f' f -> Maybe (Value l l' f' f)
forall a b. (a -> b) -> a -> b
$ Text -> Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Text -> Value l l' f' f
Abstract.builtin Text
name)
predefined Version l
ISO = [(QualIdent Language,
  Maybe (Value Language Language Placed Placed))]
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(QualIdent Language,
   Maybe (Value Language Language Placed Placed))]
 -> Map
      (QualIdent Language)
      (Maybe (Value Language Language Placed Placed)))
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
-> Map
     (QualIdent Language)
     (Maybe (Value Language Language Placed Placed))
forall a b. (a -> b) -> a -> b
$ ((Text, Maybe (Value Language Language Placed Placed))
 -> (QualIdent Language,
     Maybe (Value Language Language Placed Placed)))
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> QualIdent Language)
-> (Text, Maybe (Value Language Language Placed Placed))
-> (QualIdent Language,
    Maybe (Value Language Language Placed Placed))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> QualIdent Language
forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent) ([(Text, Maybe (Value Language Language Placed Placed))]
 -> [(QualIdent Language,
      Maybe (Value Language Language Placed Placed))])
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(QualIdent Language,
     Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> a -> b
$
   [(Text
"TRUE", Value Language Language Placed Placed
-> Maybe (Value Language Language Placed Placed)
forall a. a -> Maybe a
Just Value Language Language Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.true),
    (Text
"FALSE", Value Language Language Placed Placed
-> Maybe (Value Language Language Placed Placed)
forall a. a -> Maybe a
Just Value Language Language Placed Placed
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Value l l' f' f
Abstract.false)]
   [(Text, Maybe (Value Language Language Placed Placed))]
-> [(Text, Maybe (Value Language Language Placed Placed))]
-> [(Text, Maybe (Value Language Language Placed Placed))]
forall a. [a] -> [a] -> [a]
++ (Text -> (Text, Maybe (Value Language Language Placed Placed)))
-> [Text]
-> [(Text, Maybe (Value Language Language Placed Placed))]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Maybe (Value Language Language Placed Placed))
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Text -> (Text, Maybe (Value l l' f' f))
builtin [Text
"BITSET", Text
"BOOLEAN", Text
"CARDINAL", Text
"CHAR", Text
"INTEGER", Text
"PROC", Text
"REAL",
                   Text
"ABS", Text
"CAP", Text
"CHR", Text
"FLOAT", Text
"HIGH", Text
"MAX", Text
"MIN", Text
"ODD", Text
"ORD", Text
"TRUNC", Text
"VAL"]
   where builtin :: Text -> (Text, Maybe (Value l l' f' f))
builtin Text
name = (Text
name, Value l l' f' f -> Maybe (Value l l' f' f)
forall a. a -> Maybe a
Just (Value l l' f' f -> Maybe (Value l l' f' f))
-> Value l l' f' f -> Maybe (Value l l' f' f)
forall a b. (a -> b) -> a -> b
$ Text -> Value l l' f' f
forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
Text -> Value l l' f' f
Abstract.builtin Text
name)

-- | Parse the given text of a single module.
parseModule :: Version l -> Text -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
parseModule :: Version l
-> Text -> ParseResults Text [Placed (Module l l Placed Placed)]
parseModule Version l
Report Text
source = Text
-> Modula2Grammar
     Language
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> ParseResults
     Text [Placed (Module Language Language Placed Placed)]
forall l.
Functor (Map NodeWrap Placed) (Module l l) =>
Text
-> Modula2Grammar
     l
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> ParseResults Text [Placed (Module l l Placed Placed)]
resolve Text
source (Modula2Grammar
  Language NodeWrap (Parser (Modula2Grammar Language NodeWrap) Text)
-> Text
-> Modula2Grammar
     Language
     NodeWrap
     (ResultFunctor (Parser (Modula2Grammar Language NodeWrap) Text))
forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
 FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete Modula2Grammar
  Language NodeWrap (Parser (Modula2Grammar Language NodeWrap) Text)
Grammar.modula2grammar Text
source)
parseModule Version l
ISO Text
source = Text
-> Modula2Grammar
     Language
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> ParseResults
     Text [Placed (Module Language Language Placed Placed)]
forall l.
Functor (Map NodeWrap Placed) (Module l l) =>
Text
-> Modula2Grammar
     l
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> ParseResults Text [Placed (Module l l Placed Placed)]
resolve Text
source (Product
  (ISOMixin Language NodeWrap)
  (Modula2Grammar Language NodeWrap)
  (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> Modula2Grammar
     Language
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
forall k (g :: k -> *) (h :: k -> *) (p :: k). Product g h p -> h p
Rank2.snd (Product
   (ISOMixin Language NodeWrap)
   (Modula2Grammar Language NodeWrap)
   (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
 -> Modula2Grammar
      Language
      NodeWrap
      (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]])))
-> Product
     (ISOMixin Language NodeWrap)
     (Modula2Grammar Language NodeWrap)
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> Modula2Grammar
     Language
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
forall a b. (a -> b) -> a -> b
$ Product
  (ISOMixin Language NodeWrap)
  (Modula2Grammar Language NodeWrap)
  (Parser (ISOGrammar Language) Text)
-> Text
-> Product
     (ISOMixin Language NodeWrap)
     (Modula2Grammar Language NodeWrap)
     (ResultFunctor (Parser (ISOGrammar Language) Text))
forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
 FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete Product
  (ISOMixin Language NodeWrap)
  (Modula2Grammar Language NodeWrap)
  (Parser (ISOGrammar Language) Text)
ISO.Grammar.modula2ISOgrammar Text
source)

resolve :: Deep.Functor (Rank2.Map Grammar.NodeWrap Placed) (Abstract.Module l l)
        => Text
        -> Grammar.Modula2Grammar l Grammar.NodeWrap (Compose (Compose (ParseResults Text) []) ((,) [[Grammar.Lexeme]]))
        -> ParseResults Text [Placed (Abstract.Module l l Placed Placed)]
resolve :: Text
-> Modula2Grammar
     l
     NodeWrap
     (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> ParseResults Text [Placed (Module l l Placed Placed)]
resolve Text
source Modula2Grammar
  l
  NodeWrap
  (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
results = Compose (ParseResults Text) [] (Placed (Module l l Placed Placed))
-> ParseResults Text [Placed (Module l l Placed Placed)]
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Text
-> NodeWrap (Module l l NodeWrap NodeWrap)
-> Placed (Module l l Placed Placed)
forall (p :: * -> *) (q :: * -> *)
       (g :: (* -> *) -> (* -> *) -> *).
(p ~ NodeWrap, q ~ Placed, Functor (Map p q) g) =>
Text -> p (g p p) -> q (g q q)
resolvePositions Text
source (NodeWrap (Module l l NodeWrap NodeWrap)
 -> Placed (Module l l Placed Placed))
-> (([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
    -> NodeWrap (Module l l NodeWrap NodeWrap))
-> ([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
-> Placed (Module l l Placed Placed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
-> NodeWrap (Module l l NodeWrap NodeWrap)
forall a b. (a, b) -> b
snd (([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
 -> Placed (Module l l Placed Placed))
-> Compose
     (ParseResults Text)
     []
     ([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
-> Compose
     (ParseResults Text) [] (Placed (Module l l Placed Placed))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compose
  (Compose (ParseResults Text) [])
  ((,) [[Lexeme]])
  (NodeWrap (Module l l NodeWrap NodeWrap))
-> Compose
     (ParseResults Text)
     []
     ([[Lexeme]], NodeWrap (Module l l NodeWrap NodeWrap))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Modula2Grammar
  l
  NodeWrap
  (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
-> Compose
     (Compose (ParseResults Text) [])
     ((,) [[Lexeme]])
     (NodeWrap (Module l l NodeWrap NodeWrap))
forall l (f :: * -> *) (p :: * -> *).
Modula2Grammar l f p -> p (NodeWrap (Module l l f f))
Grammar.compilationUnit Modula2Grammar
  l
  NodeWrap
  (Compose (Compose (ParseResults Text) []) ((,) [[Lexeme]]))
results))

{-
parseNamedModule :: FilePath -> Text -> IO (ParseResults Text [Module Language Language Placed Placed])
parseNamedModule path name =
   do let basePath = combine path (unpack name)
      isDefn <- doesFileExist (addExtension basePath "Def")
      src <- readFile (addExtension basePath $ if isDefn then "Def" else "Mod")
      return (getCompose $ resolvePositions src <$> Grammar.compilationUnit (parseComplete Grammar.modula2grammar src))

parseImportsOf :: FilePath -> Map Text (Module Language Language Placed Placed)
               -> IO (Map Text (Module Language Language Placed Placed))
parseImportsOf path modules =
   case filter (`Map.notMember` modules) moduleImports
   of [] -> return modules
      newImports -> (((modules <>) . Map.fromList . map assertSuccess) <$>
                     (traverse . traverse) (parseNamedModule path) [(p, p) | p <- newImports])
                    >>= parseImportsOf path
   where moduleImports = foldMap (fmap importedModule . importsOf) modules
         importedModule (Import _ m) = m
         importsOf (DefinitionModule _ imports _ _) = imports
         importsOf (ImplementationModule _ _ imports _) = imports
         importsOf (ProgramModule _ _ imports _) = imports
         assertSuccess (m, Left err) = error ("Parse error in module " <> unpack m)
         assertSuccess (m, Right [p]) = (m, p)
         assertSuccess (m, Right _) = error ("Ambiguous parses of module " <> unpack m)
-}