{-# LANGUAGE CPP #-}

module Cubix.ParsePretty (
    ParseFile(..)
  , ParseFileTrackSources(..)
  , Pretty(..)

  , parseLua
  , prettyLua

  , RootSort

#ifndef ONLY_ONE_LANGUAGE
  , parseC
  , parseJava
  , parseJavaScript
  , parsePython

  , prettyC
  , prettyJava
  , prettyJavaScript
  , prettyPython
#endif
  ) where


import Control.Monad ( liftM, (>=>) )
import Control.Monad.Identity ( runIdentity )

import Data.Comp.Multi ( Term, AnnTerm, stripA, ann )
import Data.Comp.Multi.Strategic ( RewriteM, allbuR, promoteR )
import Data.Comp.Multi.Strategy.Classification ( DynCase, fromDynProj )

import qualified Data.Text.IO as Text

import qualified Language.C as C
import qualified Language.Java.Pretty as Java
import qualified Language.JavaScript.Parser as JS
import qualified Language.JavaScript.Pretty.Printer.Extended as JS
import qualified Language.Lua.Annotated as Lua
import qualified Language.Lua.Annotated.Lexer as Lua
import qualified Language.Lua.PrettyPrinter as Lua
import qualified Language.Lua.Annotated.Simplify as Lua
import qualified Language.Python.Common as Python
import qualified Language.Python.Version3.Parser as Python

import Cubix.Language.Info

import           Cubix.Language.C.Parametric.Common          as CCommon
import qualified Cubix.Language.C.Parametric.Full            as CFull
import qualified Cubix.Language.C.Parse                      as CParse
import qualified Cubix.Language.Java.Parse                   as JParse
import           Cubix.Language.Java.Parametric.Common       as JCommon
import qualified Cubix.Language.Java.Parametric.Full         as JFull
import           Cubix.Language.JavaScript.Parametric.Common as JSCommon
import qualified Cubix.Language.JavaScript.Parametric.Full   as JSFull
import           Cubix.Language.Lua.Parametric.Common        as LCommon
import qualified Cubix.Language.Lua.Parametric.Full          as LFull
import           Cubix.Language.Python.Parametric.Common     as PCommon
import qualified Cubix.Language.Python.Parametric.Full       as PFull

import qualified Data.Text as T (unpack)
import qualified Cubix.Language.Java.Parametric.Common as Python

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

-------------------------------------------------------------------
--------------------- General interfaces --------------------------
-------------------------------------------------------------------

type family RootSort (fs :: [(* -> *) -> * -> *])

class ParseFile fs where
  -- | Parses a file with the appropriate parser for the language with signature @fs@.
  --
  -- Recommended to use with the @TypeApplications@ extension,
  -- e.g.: @parseFile \@MCSig "my_file.c"@.
  parseFile :: FilePath -> IO (Maybe (Term fs (RootSort fs)))

class (ParseFile fs) => ParseFileTrackSources fs where
  -- | Parses a file with the appropriate parser for the language with signature @fs@,
  --   tracking source positions of many nodes. (Which depends on the language frontend)
  --
  -- Recommended to use with the @TypeApplications@ extension,
  -- e.g.: @parseFileTrackSources \@MCSig "my_file.c"@.
  parseFileTrackSources :: FilePath -> IO (Maybe (AnnTerm (Maybe SourceSpan) fs (RootSort fs)))

class Pretty fs where
  -- | Pretty-prints a term, using the appropriate pretty-printer for the language with
  -- signature @fs@.
  pretty :: Term fs (RootSort fs) -> String

  -- FIXME: The only reason this is needed is because Project forgets
  -- what sort its contents are
  prettyUnsafe :: Term fs l -> String
  default prettyUnsafe :: (DynCase (Term fs) (RootSort fs)) => Term fs l -> String
  prettyUnsafe = Term fs (RootSort fs) -> String
forall (fs :: [(* -> *) -> * -> *]).
Pretty fs =>
Term fs (RootSort fs) -> String
pretty (Term fs (RootSort fs) -> String)
-> (Term fs l -> Term fs (RootSort fs)) -> Term fs l -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term fs l -> Term fs (RootSort fs)
forall (f :: * -> *) l l'. DynCase f l => f l' -> f l
fromDynProj


-------------------------------------------------------------------
------------------------------ Lua --------------------------------
-------------------------------------------------------------------

-- | NOTE: This reflects the half-finished transition of Lua to annotated terms
parseLua :: FilePath -> IO (Maybe (MLuaTerm LBlockL))
parseLua :: String -> IO (Maybe (MLuaTerm LBlockL))
parseLua String
path = do
    Either (SourceRange, String) (Block SourceRange)
res <- String -> IO (Either (SourceRange, String) (Block SourceRange))
Lua.parseFile String
path
    case Either (SourceRange, String) (Block SourceRange)
res of
     Left (SourceRange, String)
errors -> (SourceRange, String) -> IO ()
forall a. Show a => a -> IO ()
print (SourceRange, String)
errors IO ()
-> IO (Maybe (MLuaTerm LBlockL)) -> IO (Maybe (MLuaTerm LBlockL))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MLuaTerm LBlockL) -> IO (Maybe (MLuaTerm LBlockL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MLuaTerm LBlockL)
forall a. Maybe a
Nothing
     Right Block SourceRange
tree  -> Maybe (MLuaTerm LBlockL) -> IO (Maybe (MLuaTerm LBlockL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MLuaTerm LBlockL) -> IO (Maybe (MLuaTerm LBlockL)))
-> Maybe (MLuaTerm LBlockL) -> IO (Maybe (MLuaTerm LBlockL))
forall a b. (a -> b) -> a -> b
$ MLuaTerm LBlockL -> Maybe (MLuaTerm LBlockL)
forall a. a -> Maybe a
Just (MLuaTerm LBlockL -> Maybe (MLuaTerm LBlockL))
-> MLuaTerm LBlockL -> Maybe (MLuaTerm LBlockL)
forall a b. (a -> b) -> a -> b
$ LuaTerm LBlockL -> MLuaTerm LBlockL
forall l. LuaTerm l -> MLuaTerm l
LCommon.translate (LuaTerm LBlockL -> MLuaTerm LBlockL)
-> LuaTerm LBlockL -> MLuaTerm LBlockL
forall a b. (a -> b) -> a -> b
$ Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
-> LuaTerm LBlockL
CxtFun (Sum LuaSig :&: Maybe SourceSpan) (Sum LuaSig)
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA (Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
 -> LuaTerm LBlockL)
-> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
-> LuaTerm LBlockL
forall a b. (a -> b) -> a -> b
$ Block (Maybe SourceSpan)
-> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
LFull.translate (Block (Maybe SourceSpan)
 -> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL)
-> Block (Maybe SourceSpan)
-> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
forall a b. (a -> b) -> a -> b
$ (SourceRange -> Maybe SourceSpan)
-> Block SourceRange -> Block (Maybe SourceSpan)
forall a b. (a -> b) -> Block a -> Block b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SourceRange -> Maybe SourceSpan
toSourceSpan Block SourceRange
tree
  where
    toSourceSpan :: Lua.SourceRange -> Maybe SourceSpan
    toSourceSpan :: SourceRange -> Maybe SourceSpan
toSourceSpan SourceRange
x = SourceSpan -> Maybe SourceSpan
forall a. a -> Maybe a
Just (SourceSpan -> Maybe SourceSpan) -> SourceSpan -> Maybe SourceSpan
forall a b. (a -> b) -> a -> b
$ String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan (Text -> String
T.unpack (SourcePos -> Text
Lua.sourceFile SourcePos
from))
                                         (SourcePos -> Int
Lua.sourceLine SourcePos
from, SourcePos -> Int
Lua.sourceColumn SourcePos
from)
                                         (SourcePos -> Int
Lua.sourceLine SourcePos
to,   SourcePos -> Int
Lua.sourceColumn SourcePos
to)
      where
        from :: SourcePos
from = SourceRange -> SourcePos
Lua.sourceFrom SourceRange
x
        to :: SourcePos
to   = SourceRange -> SourcePos
Lua.sourceTo   SourceRange
x

prettyLua :: MLuaTerm LBlockL -> String
prettyLua :: MLuaTerm LBlockL -> String
prettyLua = Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (MLuaTerm LBlockL -> Doc) -> MLuaTerm LBlockL -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Doc
forall a. LPretty a => a -> Doc
Lua.pprint (Block -> Doc)
-> (MLuaTerm LBlockL -> Block) -> MLuaTerm LBlockL -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (Maybe SourceSpan) -> Block
forall a. Block a -> Block
Lua.sBlock (Block (Maybe SourceSpan) -> Block)
-> (MLuaTerm LBlockL -> Block (Maybe SourceSpan))
-> MLuaTerm LBlockL
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
-> Block (Maybe SourceSpan)
Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
-> Targ LBlockL
forall i. AnnTerm (Maybe SourceSpan) LuaSig i -> Targ i
LFull.untranslate (Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
 -> Block (Maybe SourceSpan))
-> (MLuaTerm LBlockL
    -> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL)
-> MLuaTerm LBlockL
-> Block (Maybe SourceSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan
-> CxtFun (Sum LuaSig) (Sum LuaSig :&: Maybe SourceSpan)
forall (f :: (* -> *) -> * -> *) p.
HFunctor f =>
p -> CxtFun f (f :&: p)
ann Maybe SourceSpan
forall a. Maybe a
Nothing (LuaTerm LBlockL
 -> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL)
-> (MLuaTerm LBlockL -> LuaTerm LBlockL)
-> MLuaTerm LBlockL
-> Cxt NoHole (Sum LuaSig :&: Maybe SourceSpan) (K ()) LBlockL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MLuaTerm LBlockL -> LuaTerm LBlockL
forall l. MLuaTerm l -> LuaTerm l
LCommon.untranslate

type instance RootSort MLuaSig = LBlockL
instance ParseFile MLuaSig where parseFile :: String -> IO (Maybe (Term MLuaSig (RootSort MLuaSig)))
parseFile = String -> IO (Maybe (MLuaTerm LBlockL))
String -> IO (Maybe (Term MLuaSig (RootSort MLuaSig)))
parseLua
instance Pretty MLuaSig where pretty :: Term MLuaSig (RootSort MLuaSig) -> String
pretty = MLuaTerm LBlockL -> String
Term MLuaSig (RootSort MLuaSig) -> String
prettyLua

#ifndef ONLY_ONE_LANGUAGE


-------------------------------------------------------------------
------------------------------- C ---------------------------------
-------------------------------------------------------------------

parseC :: FilePath -> IO (Maybe (MCTerm CTranslationUnitL))
parseC :: String -> IO (Maybe (MCTerm CTranslationUnitL))
parseC String
path = do
  Either String (CTranslationUnit NodeInfo)
res <- String -> IO (Either String (CTranslationUnit NodeInfo))
CParse.parse String
path
  case Either String (CTranslationUnit NodeInfo)
res of
    Left String
errors -> String -> IO ()
forall a. Show a => a -> IO ()
print String
errors IO ()
-> IO (Maybe (MCTerm CTranslationUnitL))
-> IO (Maybe (MCTerm CTranslationUnitL))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MCTerm CTranslationUnitL)
-> IO (Maybe (MCTerm CTranslationUnitL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MCTerm CTranslationUnitL)
forall a. Maybe a
Nothing
    Right CTranslationUnit NodeInfo
tree -> Maybe (MCTerm CTranslationUnitL)
-> IO (Maybe (MCTerm CTranslationUnitL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MCTerm CTranslationUnitL)
 -> IO (Maybe (MCTerm CTranslationUnitL)))
-> Maybe (MCTerm CTranslationUnitL)
-> IO (Maybe (MCTerm CTranslationUnitL))
forall a b. (a -> b) -> a -> b
$ MCTerm CTranslationUnitL -> Maybe (MCTerm CTranslationUnitL)
forall a. a -> Maybe a
Just (MCTerm CTranslationUnitL -> Maybe (MCTerm CTranslationUnitL))
-> MCTerm CTranslationUnitL -> Maybe (MCTerm CTranslationUnitL)
forall a b. (a -> b) -> a -> b
$ CTerm CTranslationUnitL -> MCTerm CTranslationUnitL
forall l. CTerm l -> MCTerm l
CCommon.translate (CTerm CTranslationUnitL -> MCTerm CTranslationUnitL)
-> CTerm CTranslationUnitL -> MCTerm CTranslationUnitL
forall a b. (a -> b) -> a -> b
$ CTranslationUnit () -> CTerm CTranslationUnitL
CFull.translate (CTranslationUnit () -> CTerm CTranslationUnitL)
-> CTranslationUnit () -> CTerm CTranslationUnitL
forall a b. (a -> b) -> a -> b
$ (NodeInfo -> ())
-> CTranslationUnit NodeInfo -> CTranslationUnit ()
forall a b. (a -> b) -> CTranslationUnit a -> CTranslationUnit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> NodeInfo -> ()
forall a b. a -> b -> a
const ()) CTranslationUnit NodeInfo
tree


dummyNodeInfo :: C.NodeInfo
dummyNodeInfo :: NodeInfo
dummyNodeInfo = Position -> NodeInfo
C.mkNodeInfoOnlyPos Position
C.nopos


prettyC :: MCTerm CTranslationUnitL -> String
prettyC :: MCTerm CTranslationUnitL -> String
prettyC = Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (MCTerm CTranslationUnitL -> Doc)
-> MCTerm CTranslationUnitL
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTranslationUnit NodeInfo -> Doc
forall p. Pretty p => p -> Doc
C.pretty (CTranslationUnit NodeInfo -> Doc)
-> (MCTerm CTranslationUnitL -> CTranslationUnit NodeInfo)
-> MCTerm CTranslationUnitL
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> NodeInfo)
-> CTranslationUnit () -> CTranslationUnit NodeInfo
forall a b. (a -> b) -> CTranslationUnit a -> CTranslationUnit b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeInfo -> () -> NodeInfo
forall a b. a -> b -> a
const NodeInfo
dummyNodeInfo) (CTranslationUnit () -> CTranslationUnit NodeInfo)
-> (MCTerm CTranslationUnitL -> CTranslationUnit ())
-> MCTerm CTranslationUnitL
-> CTranslationUnit NodeInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTerm CTranslationUnitL -> CTranslationUnit ()
CTerm CTranslationUnitL -> Targ CTranslationUnitL
forall i. CTerm i -> Targ i
CFull.untranslate (CTerm CTranslationUnitL -> CTranslationUnit ())
-> (MCTerm CTranslationUnitL -> CTerm CTranslationUnitL)
-> MCTerm CTranslationUnitL
-> CTranslationUnit ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MCTerm CTranslationUnitL -> CTerm CTranslationUnitL
forall l. MCTerm l -> CTerm l
CCommon.untranslate

type instance RootSort MCSig = CTranslationUnitL
instance ParseFile MCSig where parseFile :: String -> IO (Maybe (Term MCSig (RootSort MCSig)))
parseFile = String -> IO (Maybe (MCTerm CTranslationUnitL))
String -> IO (Maybe (Term MCSig (RootSort MCSig)))
parseC
instance Pretty MCSig where pretty :: Term MCSig (RootSort MCSig) -> String
pretty = MCTerm CTranslationUnitL -> String
Term MCSig (RootSort MCSig) -> String
prettyC


-------------------------------------------------------------------
----------------------------- Java --------------------------------
-------------------------------------------------------------------

parseJava :: FilePath -> IO (Maybe (MJavaTerm CompilationUnitL))
parseJava :: String -> IO (Maybe (MJavaTerm CompilationUnitL))
parseJava String
path = do
  Either String CompilationUnit
res <- String -> IO (Either String CompilationUnit)
JParse.parse String
path
  case Either String CompilationUnit
res of
    Left  String
x -> Maybe (MJavaTerm CompilationUnitL)
-> IO (Maybe (MJavaTerm CompilationUnitL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MJavaTerm CompilationUnitL)
forall a. Maybe a
Nothing
    Right CompilationUnit
p -> Maybe (MJavaTerm CompilationUnitL)
-> IO (Maybe (MJavaTerm CompilationUnitL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MJavaTerm CompilationUnitL)
 -> IO (Maybe (MJavaTerm CompilationUnitL)))
-> Maybe (MJavaTerm CompilationUnitL)
-> IO (Maybe (MJavaTerm CompilationUnitL))
forall a b. (a -> b) -> a -> b
$ MJavaTerm CompilationUnitL -> Maybe (MJavaTerm CompilationUnitL)
forall a. a -> Maybe a
Just (MJavaTerm CompilationUnitL -> Maybe (MJavaTerm CompilationUnitL))
-> MJavaTerm CompilationUnitL -> Maybe (MJavaTerm CompilationUnitL)
forall a b. (a -> b) -> a -> b
$ JavaTerm CompilationUnitL -> MJavaTerm CompilationUnitL
forall l. JavaTerm l -> MJavaTerm l
JCommon.translate (JavaTerm CompilationUnitL -> MJavaTerm CompilationUnitL)
-> JavaTerm CompilationUnitL -> MJavaTerm CompilationUnitL
forall a b. (a -> b) -> a -> b
$ CompilationUnit -> JavaTerm CompilationUnitL
JFull.translate CompilationUnit
p


prettyJava :: MJavaTerm CompilationUnitL -> String
prettyJava :: MJavaTerm CompilationUnitL -> String
prettyJava = CompilationUnit -> String
forall a. Pretty a => a -> String
Java.prettyPrint (CompilationUnit -> String)
-> (MJavaTerm CompilationUnitL -> CompilationUnit)
-> MJavaTerm CompilationUnitL
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JavaTerm CompilationUnitL -> CompilationUnit
JavaTerm CompilationUnitL -> Targ CompilationUnitL
forall i. JavaTerm i -> Targ i
JFull.untranslate (JavaTerm CompilationUnitL -> CompilationUnit)
-> (MJavaTerm CompilationUnitL -> JavaTerm CompilationUnitL)
-> MJavaTerm CompilationUnitL
-> CompilationUnit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MJavaTerm CompilationUnitL -> JavaTerm CompilationUnitL
forall l. MJavaTerm l -> JavaTerm l
JCommon.untranslate


type instance RootSort MJavaSig = CompilationUnitL
instance ParseFile MJavaSig where parseFile :: String -> IO (Maybe (Term MJavaSig (RootSort MJavaSig)))
parseFile = String -> IO (Maybe (MJavaTerm CompilationUnitL))
String -> IO (Maybe (Term MJavaSig (RootSort MJavaSig)))
parseJava
instance Pretty MJavaSig where pretty :: Term MJavaSig (RootSort MJavaSig) -> String
pretty = MJavaTerm CompilationUnitL -> String
Term MJavaSig (RootSort MJavaSig) -> String
prettyJava


-------------------------------------------------------------------
--------------------------- JavaScript ----------------------------
-------------------------------------------------------------------

parseJavaScript :: FilePath -> IO (Maybe (MJSTerm JSASTL))
parseJavaScript :: String -> IO (Maybe (MJSTerm JSASTL))
parseJavaScript String
path = (JSAST -> Maybe (MJSTerm JSASTL))
-> IO JSAST -> IO (Maybe (MJSTerm JSASTL))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (MJSTerm JSASTL -> Maybe (MJSTerm JSASTL)
forall a. a -> Maybe a
Just (MJSTerm JSASTL -> Maybe (MJSTerm JSASTL))
-> (JSAST -> MJSTerm JSASTL) -> JSAST -> Maybe (MJSTerm JSASTL)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSTerm JSASTL -> MJSTerm JSASTL
forall l. JSTerm l -> MJSTerm l
JSCommon.translate (JSTerm JSASTL -> MJSTerm JSASTL)
-> (JSAST -> JSTerm JSASTL) -> JSAST -> MJSTerm JSASTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSTerm JSASTL -> JSTerm JSASTL
normalizeJS (JSTerm JSASTL -> JSTerm JSASTL)
-> (JSAST -> JSTerm JSASTL) -> JSAST -> JSTerm JSASTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSAST -> JSTerm JSASTL
JSFull.translate) (IO JSAST -> IO (Maybe (MJSTerm JSASTL)))
-> IO JSAST -> IO (Maybe (MJSTerm JSASTL))
forall a b. (a -> b) -> a -> b
$ String -> IO JSAST
JS.parseFile String
path
  where
    normalizeJS :: JSFull.JSTerm JSASTL -> JSFull.JSTerm JSASTL
    normalizeJS :: JSTerm JSASTL -> JSTerm JSASTL
normalizeJS JSTerm JSASTL
t = Identity (JSTerm JSASTL) -> JSTerm JSASTL
forall a. Identity a -> a
runIdentity (Identity (JSTerm JSASTL) -> JSTerm JSASTL)
-> Identity (JSTerm JSASTL) -> JSTerm JSASTL
forall a b. (a -> b) -> a -> b
$ GRewriteM Identity (Cxt NoHole (Sum JSSig) (K ()))
-> GRewriteM Identity (Cxt NoHole (Sum JSSig) (K ()))
forall (m :: * -> *) (f :: (* -> *) -> * -> *) h (a :: * -> *).
(Monad m, HTraversable f) =>
GRewriteM m (Cxt h f a) -> GRewriteM m (Cxt h f a)
allbuR (RewriteM (MaybeT Identity) (Cxt NoHole (Sum JSSig) (K ())) JSSemiL
-> GRewriteM Identity (Cxt NoHole (Sum JSSig) (K ()))
forall (f :: * -> *) l (m :: * -> *).
(DynCase f l, Monad m) =>
RewriteM (MaybeT m) f l -> GRewriteM m f
promoteR RewriteM (MaybeT Identity) (Cxt NoHole (Sum JSSig) (K ())) JSSemiL
forall (m :: * -> *).
Monad m =>
RewriteM m (Cxt NoHole (Sum JSSig) (K ())) JSSemiL
normalizeSemi RewriteM Identity (Cxt NoHole (Sum JSSig) (K ())) l
-> RewriteM Identity (Cxt NoHole (Sum JSSig) (K ())) l
-> RewriteM Identity (Cxt NoHole (Sum JSSig) (K ())) l
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> RewriteM (MaybeT Identity) (Cxt NoHole (Sum JSSig) (K ())) JSAnnotL
-> GRewriteM Identity (Cxt NoHole (Sum JSSig) (K ()))
forall (f :: * -> *) l (m :: * -> *).
(DynCase f l, Monad m) =>
RewriteM (MaybeT m) f l -> GRewriteM m f
promoteR RewriteM (MaybeT Identity) (Cxt NoHole (Sum JSSig) (K ())) JSAnnotL
forall (m :: * -> *).
Monad m =>
RewriteM m (Cxt NoHole (Sum JSSig) (K ())) JSAnnotL
normalizeAnno) JSTerm JSASTL
t

    normalizeSemi :: (Monad m) => RewriteM m JSFull.JSTerm JSSemiL
    normalizeSemi :: forall (m :: * -> *).
Monad m =>
RewriteM m (Cxt NoHole (Sum JSSig) (K ())) JSSemiL
normalizeSemi JSTerm JSSemiL
_ = JSTerm JSSemiL -> m (JSTerm JSSemiL)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CxtS NoHole JSSig (K ()) JSAnnotL -> JSTerm JSSemiL
forall h (fs :: [(* -> *) -> * -> *]) (a :: * -> *) j.
(JSSemi :-<: fs, InjF fs JSSemiL j) =>
CxtS h fs a JSAnnotL -> CxtS h fs a j
iJSSemi CxtS NoHole JSSig (K ()) JSAnnotL
forall h (fs :: [(* -> *) -> * -> *]) (a :: * -> *) j.
(JSAnnot :-<: fs, InjF fs JSAnnotL j) =>
CxtS h fs a j
iJSNoAnnot)

    normalizeAnno :: (Monad m) => RewriteM m JSFull.JSTerm JSAnnotL
    normalizeAnno :: forall (m :: * -> *).
Monad m =>
RewriteM m (Cxt NoHole (Sum JSSig) (K ())) JSAnnotL
normalizeAnno CxtS NoHole JSSig (K ()) JSAnnotL
_ = CxtS NoHole JSSig (K ()) JSAnnotL
-> m (CxtS NoHole JSSig (K ()) JSAnnotL)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CxtS NoHole JSSig (K ()) JSAnnotL
forall h (fs :: [(* -> *) -> * -> *]) (a :: * -> *) j.
(JSAnnot :-<: fs, InjF fs JSAnnotL j) =>
CxtS h fs a j
iJSNoAnnot

prettyJavaScript :: MJSTerm JSASTL -> String
prettyJavaScript :: MJSTerm JSASTL -> String
prettyJavaScript =  JSAST -> String
forall a. Pretty a => a -> String
JS.prettyPrint (JSAST -> String)
-> (MJSTerm JSASTL -> JSAST) -> MJSTerm JSASTL -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSTerm JSASTL -> JSAST
JSTerm JSASTL -> Targ JSASTL
forall i. JSTerm i -> Targ i
JSFull.untranslate (JSTerm JSASTL -> JSAST)
-> (MJSTerm JSASTL -> JSTerm JSASTL) -> MJSTerm JSASTL -> JSAST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MJSTerm JSASTL -> JSTerm JSASTL
forall l. MJSTerm l -> JSTerm l
JSCommon.untranslate


type instance RootSort MJSSig = JSASTL
instance ParseFile MJSSig where parseFile :: String -> IO (Maybe (Term MJSSig (RootSort MJSSig)))
parseFile = String -> IO (Maybe (MJSTerm JSASTL))
String -> IO (Maybe (Term MJSSig (RootSort MJSSig)))
parseJavaScript
instance Pretty MJSSig where pretty :: Term MJSSig (RootSort MJSSig) -> String
pretty = MJSTerm JSASTL -> String
Term MJSSig (RootSort MJSSig) -> String
prettyJavaScript

-------------------------------------------------------------------
----------------------------- Python ------------------------------
-------------------------------------------------------------------

parsePython :: FilePath -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) PCommon.ModuleL))
parsePython :: String -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
parsePython String
path = do
    String
contents <- String -> IO String
readFile String
path
    let res :: Either ParseError (ModuleSpan, [Token])
res = String -> String -> Either ParseError (ModuleSpan, [Token])
Python.parseModule String
contents String
path
    case Either ParseError (ModuleSpan, [Token])
res of
      Left  ParseError
e      -> ParseError -> IO ()
forall a. Show a => a -> IO ()
print ParseError
e IO ()
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
forall a. Maybe a
Nothing
      Right (ModuleSpan
m, [Token]
_) -> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
 -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)))
-> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
forall a b. (a -> b) -> a -> b
$ MPythonTermAnn (Maybe SourceSpan) ModuleL
-> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
forall a. a -> Maybe a
Just (MPythonTermAnn (Maybe SourceSpan) ModuleL
 -> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
-> MPythonTermAnn (Maybe SourceSpan) ModuleL
-> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
forall a b. (a -> b) -> a -> b
$ PythonTermAnn (Maybe SourceSpan) ModuleL
-> MPythonTermAnn (Maybe SourceSpan) ModuleL
forall a l. Default a => PythonTermAnn a l -> MPythonTermAnn a l
PCommon.translate (PythonTermAnn (Maybe SourceSpan) ModuleL
 -> MPythonTermAnn (Maybe SourceSpan) ModuleL)
-> PythonTermAnn (Maybe SourceSpan) ModuleL
-> MPythonTermAnn (Maybe SourceSpan) ModuleL
forall a b. (a -> b) -> a -> b
$ Module (Maybe SourceSpan)
-> PythonTermAnn (Maybe SourceSpan) ModuleL
PFull.translate (Module (Maybe SourceSpan)
 -> PythonTermAnn (Maybe SourceSpan) ModuleL)
-> Module (Maybe SourceSpan)
-> PythonTermAnn (Maybe SourceSpan) ModuleL
forall a b. (a -> b) -> a -> b
$ (SrcSpan -> Maybe SourceSpan)
-> ModuleSpan -> Module (Maybe SourceSpan)
forall a b. (a -> b) -> Module a -> Module b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SrcSpan -> Maybe SourceSpan
toSourceSpan ModuleSpan
m
  where
    toSourceSpan :: Python.SrcSpan -> Maybe SourceSpan
    toSourceSpan :: SrcSpan -> Maybe SourceSpan
toSourceSpan (Python.SpanCoLinear String
filename Int
row Int
start Int
end) = SourceSpan -> Maybe SourceSpan
forall a. a -> Maybe a
Just (SourceSpan -> Maybe SourceSpan) -> SourceSpan -> Maybe SourceSpan
forall a b. (a -> b) -> a -> b
$ String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan String
filename (Int
row, Int
start) (Int
row, Int
end)
    toSourceSpan (Python.SpanMultiLine String
filename Int
startRow Int
startCol Int
endRow Int
endCol) = SourceSpan -> Maybe SourceSpan
forall a. a -> Maybe a
Just (SourceSpan -> Maybe SourceSpan) -> SourceSpan -> Maybe SourceSpan
forall a b. (a -> b) -> a -> b
$ String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan String
filename (Int
startRow, Int
startCol) (Int
endRow, Int
endCol)
    toSourceSpan (Python.SpanPoint String
filename Int
row Int
col) = SourceSpan -> Maybe SourceSpan
forall a. a -> Maybe a
Just (SourceSpan -> Maybe SourceSpan) -> SourceSpan -> Maybe SourceSpan
forall a b. (a -> b) -> a -> b
$ String -> (Int, Int) -> (Int, Int) -> SourceSpan
mkSourceSpan String
filename (Int
row, Int
col) (Int
row, Int
col)
    toSourceSpan SrcSpan
Python.SpanEmpty = Maybe SourceSpan
forall a. Maybe a
Nothing

prettyPython :: MPythonTerm PCommon.ModuleL -> String
prettyPython :: MPythonTerm ModuleL -> String
prettyPython = Doc -> String
forall a. Show a => a -> String
show (Doc -> String)
-> (MPythonTerm ModuleL -> Doc) -> MPythonTerm ModuleL -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module (Maybe SourceSpan) -> Doc
forall a. Pretty a => a -> Doc
Python.pretty (Module (Maybe SourceSpan) -> Doc)
-> (MPythonTerm ModuleL -> Module (Maybe SourceSpan))
-> MPythonTerm ModuleL
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PythonTermAnn (Maybe SourceSpan) ModuleL
-> Module (Maybe SourceSpan)
PythonTermAnn (Maybe SourceSpan) ModuleL -> Targ ModuleL
forall i. AnnTerm (Maybe SourceSpan) PythonSig i -> Targ i
PFull.untranslate (PythonTermAnn (Maybe SourceSpan) ModuleL
 -> Module (Maybe SourceSpan))
-> (MPythonTerm ModuleL
    -> PythonTermAnn (Maybe SourceSpan) ModuleL)
-> MPythonTerm ModuleL
-> Module (Maybe SourceSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SourceSpan
-> CxtFun (Sum PythonSig) (Sum PythonSig :&: Maybe SourceSpan)
forall (f :: (* -> *) -> * -> *) p.
HFunctor f =>
p -> CxtFun f (f :&: p)
ann Maybe SourceSpan
forall a. Maybe a
Nothing (Cxt NoHole (Sum PythonSig) (K ()) ModuleL
 -> PythonTermAnn (Maybe SourceSpan) ModuleL)
-> (MPythonTerm ModuleL
    -> Cxt NoHole (Sum PythonSig) (K ()) ModuleL)
-> MPythonTerm ModuleL
-> PythonTermAnn (Maybe SourceSpan) ModuleL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPythonTerm ModuleL -> Cxt NoHole (Sum PythonSig) (K ()) ModuleL
forall l. MPythonTerm l -> PythonTerm l
PCommon.untranslate


type instance RootSort MPythonSig = PCommon.ModuleL
instance ParseFile MPythonSig where parseFile :: String -> IO (Maybe (Term MPythonSig (RootSort MPythonSig)))
parseFile = (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
 -> Maybe (MPythonTerm ModuleL))
-> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
-> IO (Maybe (MPythonTerm ModuleL))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MPythonTermAnn (Maybe SourceSpan) ModuleL -> MPythonTerm ModuleL)
-> Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)
-> Maybe (MPythonTerm ModuleL)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MPythonTermAnn (Maybe SourceSpan) ModuleL -> MPythonTerm ModuleL
CxtFun (Sum MPythonSig :&: Maybe SourceSpan) (Sum MPythonSig)
forall (g :: (* -> *) -> * -> *) (f :: (* -> *) -> * -> *).
(RemA g f, HFunctor g) =>
CxtFun g f
stripA) (IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
 -> IO (Maybe (MPythonTerm ModuleL)))
-> (String
    -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL)))
-> String
-> IO (Maybe (MPythonTerm ModuleL))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
parsePython
instance ParseFileTrackSources MPythonSig where parseFileTrackSources :: String
-> IO
     (Maybe
        (AnnTerm (Maybe SourceSpan) MPythonSig (RootSort MPythonSig)))
parseFileTrackSources = String -> IO (Maybe (MPythonTermAnn (Maybe SourceSpan) ModuleL))
String
-> IO
     (Maybe
        (AnnTerm (Maybe SourceSpan) MPythonSig (RootSort MPythonSig)))
parsePython
instance Pretty MPythonSig where pretty :: Term MPythonSig (RootSort MPythonSig) -> String
pretty = MPythonTerm ModuleL -> String
Term MPythonSig (RootSort MPythonSig) -> String
prettyPython

#endif