{-# LANGUAGE CPP #-}
{- |
  Module      :  Language.Haskell.Meta.Parse
  Copyright   :  (c) Matt Morrow 2008
  License     :  BSD3
  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
  Stability   :  experimental
  Portability :  portable (template-haskell)
-}

module Language.Haskell.Meta.Parse (
  parsePat,
  parseExp,
  parseType,
  parseDecs,
  parseDecsWithMode,
  myDefaultParseMode,
  myDefaultExtensions,
  parseResultToEither,
  parseHsModule,
  parseHsDecls,
  parseHsDeclsWithMode,
  parseHsType,
  parseHsExp,
  parseHsPat,
  pprHsModule,
  moduleDecls,
  noSrcSpanInfo,
  emptyHsModule
 ) where

import           Language.Haskell.Exts.Extension
import           Language.Haskell.Exts.Parser           hiding
  (parseExp, parsePat, parseType)
import           Language.Haskell.Exts.Pretty
import qualified Language.Haskell.Exts.SrcLoc           as Hs
import qualified Language.Haskell.Exts.Syntax           as Hs
import           Language.Haskell.Meta.Syntax.Translate
import           Language.Haskell.TH.Syntax             hiding (Extension (..))

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

-- * template-haskell

parsePat :: String -> Either String Pat
parsePat :: String -> Either String Pat
parsePat = (Pat SrcSpanInfo -> Pat)
-> Either String (Pat SrcSpanInfo) -> Either String Pat
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pat SrcSpanInfo -> Pat
forall a. ToPat a => a -> Pat
toPat (Either String (Pat SrcSpanInfo) -> Either String Pat)
-> (String -> Either String (Pat SrcSpanInfo))
-> String
-> Either String Pat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Pat SrcSpanInfo)
parseHsPat

parseExp :: String -> Either String Exp
parseExp :: String -> Either String Exp
parseExp = (Exp SrcSpanInfo -> Exp)
-> Either String (Exp SrcSpanInfo) -> Either String Exp
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp SrcSpanInfo -> Exp
forall a. ToExp a => a -> Exp
toExp (Either String (Exp SrcSpanInfo) -> Either String Exp)
-> (String -> Either String (Exp SrcSpanInfo))
-> String
-> Either String Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Exp SrcSpanInfo)
parseHsExp

parseType :: String -> Either String Type
parseType :: String -> Either String Type
parseType = (Type SrcSpanInfo -> Type)
-> Either String (Type SrcSpanInfo) -> Either String Type
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type SrcSpanInfo -> Type
forall a. ToType a => a -> Type
toType (Either String (Type SrcSpanInfo) -> Either String Type)
-> (String -> Either String (Type SrcSpanInfo))
-> String
-> Either String Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String (Type SrcSpanInfo)
parseHsType

parseDecs :: String -> Either String [Dec]
parseDecs :: String -> Either String [Dec]
parseDecs  = ([Decl SrcSpanInfo] -> [Dec])
-> Either String [Decl SrcSpanInfo] -> Either String [Dec]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Decl SrcSpanInfo] -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs (Either String [Decl SrcSpanInfo] -> Either String [Dec])
-> (String -> Either String [Decl SrcSpanInfo])
-> String
-> Either String [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String [Decl SrcSpanInfo]
parseHsDecls

-- | @since 0.8.2
parseDecsWithMode :: ParseMode -> String -> Either String [Dec]
parseDecsWithMode :: ParseMode -> String -> Either String [Dec]
parseDecsWithMode ParseMode
parseMode = ([Decl SrcSpanInfo] -> [Dec])
-> Either String [Decl SrcSpanInfo] -> Either String [Dec]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Decl SrcSpanInfo] -> [Dec]
forall a. ToDecs a => a -> [Dec]
toDecs
  (Either String [Decl SrcSpanInfo] -> Either String [Dec])
-> (String -> Either String [Decl SrcSpanInfo])
-> String
-> Either String [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> Either String [Decl SrcSpanInfo]
parseHsDeclsWithMode ParseMode
parseMode

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

{-# DEPRECATED myDefaultParseMode, myDefaultExtensions
  "The provided ParseModes aren't very meaningful, use your own instead" #-}
myDefaultParseMode :: ParseMode
myDefaultParseMode :: ParseMode
myDefaultParseMode = ParseMode
defaultParseMode
  {parseFilename = []
  ,baseLanguage = Haskell2010
  ,extensions = map EnableExtension myDefaultExtensions
  }

myDefaultExtensions :: [KnownExtension]
myDefaultExtensions :: [KnownExtension]
myDefaultExtensions = [KnownExtension
PostfixOperators
                      ,KnownExtension
QuasiQuotes
                      ,KnownExtension
UnicodeSyntax
                      ,KnownExtension
PatternSignatures
                      ,KnownExtension
MagicHash
                      ,KnownExtension
ForeignFunctionInterface
                      ,KnownExtension
TemplateHaskell
                      ,KnownExtension
RankNTypes
                      ,KnownExtension
MultiParamTypeClasses
                      ,KnownExtension
RecursiveDo
                      ,KnownExtension
TypeApplications]

parseResultToEither :: ParseResult a -> Either String a
parseResultToEither :: forall a. ParseResult a -> Either String a
parseResultToEither (ParseOk a
a) = a -> Either String a
forall a b. b -> Either a b
Right a
a
parseResultToEither (ParseFailed SrcLoc
loc String
e)
  = let line :: Int
line = SrcLoc -> Int
Hs.srcLine SrcLoc
loc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    in String -> Either String a
forall a b. a -> Either a b
Left ([String] -> String
unlines [Int -> String
forall a. Show a => a -> String
show Int
line,SrcLoc -> String
forall a. Show a => a -> String
show SrcLoc
loc,String
e])

parseHsModule :: String -> Either String (Hs.Module Hs.SrcSpanInfo)
parseHsModule :: String -> Either String (Module SrcSpanInfo)
parseHsModule = ParseResult (Module SrcSpanInfo)
-> Either String (Module SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Module SrcSpanInfo)
 -> Either String (Module SrcSpanInfo))
-> (String -> ParseResult (Module SrcSpanInfo))
-> String
-> Either String (Module SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Module SrcSpanInfo)
parseModuleWithMode ParseMode
myDefaultParseMode

parseHsDecls :: String -> Either String [Hs.Decl Hs.SrcSpanInfo]
parseHsDecls :: String -> Either String [Decl SrcSpanInfo]
parseHsDecls = (Module SrcSpanInfo -> [Decl SrcSpanInfo])
-> Either String (Module SrcSpanInfo)
-> Either String [Decl SrcSpanInfo]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module SrcSpanInfo -> [Decl SrcSpanInfo]
moduleDecls
  (Either String (Module SrcSpanInfo)
 -> Either String [Decl SrcSpanInfo])
-> (String -> Either String (Module SrcSpanInfo))
-> String
-> Either String [Decl SrcSpanInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult (Module SrcSpanInfo)
-> Either String (Module SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Module SrcSpanInfo)
 -> Either String (Module SrcSpanInfo))
-> (String -> ParseResult (Module SrcSpanInfo))
-> String
-> Either String (Module SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Module SrcSpanInfo)
parseModuleWithMode ParseMode
myDefaultParseMode

-- | @since 0.8.2
parseHsDeclsWithMode :: ParseMode -> String -> Either String [Hs.Decl Hs.SrcSpanInfo]
parseHsDeclsWithMode :: ParseMode -> String -> Either String [Decl SrcSpanInfo]
parseHsDeclsWithMode ParseMode
parseMode = (Module SrcSpanInfo -> [Decl SrcSpanInfo])
-> Either String (Module SrcSpanInfo)
-> Either String [Decl SrcSpanInfo]
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module SrcSpanInfo -> [Decl SrcSpanInfo]
moduleDecls
  (Either String (Module SrcSpanInfo)
 -> Either String [Decl SrcSpanInfo])
-> (String -> Either String (Module SrcSpanInfo))
-> String
-> Either String [Decl SrcSpanInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseResult (Module SrcSpanInfo)
-> Either String (Module SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Module SrcSpanInfo)
 -> Either String (Module SrcSpanInfo))
-> (String -> ParseResult (Module SrcSpanInfo))
-> String
-> Either String (Module SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Module SrcSpanInfo)
parseModuleWithMode ParseMode
parseMode


parseHsType :: String -> Either String (Hs.Type Hs.SrcSpanInfo)
parseHsType :: String -> Either String (Type SrcSpanInfo)
parseHsType = ParseResult (Type SrcSpanInfo) -> Either String (Type SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Type SrcSpanInfo)
 -> Either String (Type SrcSpanInfo))
-> (String -> ParseResult (Type SrcSpanInfo))
-> String
-> Either String (Type SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Type SrcSpanInfo)
parseTypeWithMode ParseMode
myDefaultParseMode


parseHsExp :: String -> Either String (Hs.Exp Hs.SrcSpanInfo)
parseHsExp :: String -> Either String (Exp SrcSpanInfo)
parseHsExp = ParseResult (Exp SrcSpanInfo) -> Either String (Exp SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Exp SrcSpanInfo) -> Either String (Exp SrcSpanInfo))
-> (String -> ParseResult (Exp SrcSpanInfo))
-> String
-> Either String (Exp SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Exp SrcSpanInfo)
parseExpWithMode ParseMode
myDefaultParseMode

parseHsPat :: String -> Either String (Hs.Pat Hs.SrcSpanInfo)
parseHsPat :: String -> Either String (Pat SrcSpanInfo)
parseHsPat = ParseResult (Pat SrcSpanInfo) -> Either String (Pat SrcSpanInfo)
forall a. ParseResult a -> Either String a
parseResultToEither (ParseResult (Pat SrcSpanInfo) -> Either String (Pat SrcSpanInfo))
-> (String -> ParseResult (Pat SrcSpanInfo))
-> String
-> Either String (Pat SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseMode -> String -> ParseResult (Pat SrcSpanInfo)
parsePatWithMode ParseMode
myDefaultParseMode

pprHsModule :: Hs.Module Hs.SrcSpanInfo -> String
pprHsModule :: Module SrcSpanInfo -> String
pprHsModule = Module SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint


moduleDecls :: Hs.Module Hs.SrcSpanInfo -> [Hs.Decl Hs.SrcSpanInfo]
moduleDecls :: Module SrcSpanInfo -> [Decl SrcSpanInfo]
moduleDecls (Hs.Module SrcSpanInfo
_ Maybe (ModuleHead SrcSpanInfo)
_ [ModulePragma SrcSpanInfo]
_ [ImportDecl SrcSpanInfo]
_ [Decl SrcSpanInfo]
x) = [Decl SrcSpanInfo]
x
moduleDecls Module SrcSpanInfo
m                     = String -> Module SrcSpanInfo -> [Decl SrcSpanInfo]
forall (f :: * -> *) e a.
(Functor f, Show (f ())) =>
String -> f e -> a
todo String
"" Module SrcSpanInfo
m
-- TODO
--             (Hs.XmlPage _ _ _ _ _ _ _)
--          (Hs.XmlHybrid _ _ _ _ _ _ _ _ _)

-- mkModule :: String -> Hs.Module
-- mkModule s = Hs.Module undefined (Hs.ModuleName s) Nothing [] []

emptyHsModule :: String -> Hs.Module Hs.SrcSpanInfo
emptyHsModule :: String -> Module SrcSpanInfo
emptyHsModule String
n =
    (SrcSpanInfo
-> Maybe (ModuleHead SrcSpanInfo)
-> [ModulePragma SrcSpanInfo]
-> [ImportDecl SrcSpanInfo]
-> [Decl SrcSpanInfo]
-> Module SrcSpanInfo
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Hs.Module
        SrcSpanInfo
noSrcSpanInfo
        (ModuleHead SrcSpanInfo -> Maybe (ModuleHead SrcSpanInfo)
forall a. a -> Maybe a
Just (SrcSpanInfo
-> ModuleName SrcSpanInfo
-> Maybe (WarningText SrcSpanInfo)
-> Maybe (ExportSpecList SrcSpanInfo)
-> ModuleHead SrcSpanInfo
forall l.
l
-> ModuleName l
-> Maybe (WarningText l)
-> Maybe (ExportSpecList l)
-> ModuleHead l
Hs.ModuleHead SrcSpanInfo
noSrcSpanInfo (SrcSpanInfo -> String -> ModuleName SrcSpanInfo
forall l. l -> String -> ModuleName l
Hs.ModuleName SrcSpanInfo
noSrcSpanInfo String
n) Maybe (WarningText SrcSpanInfo)
forall a. Maybe a
Nothing Maybe (ExportSpecList SrcSpanInfo)
forall a. Maybe a
Nothing))
        []
        []
        [])

noSrcSpanInfo :: Hs.SrcSpanInfo
noSrcSpanInfo :: SrcSpanInfo
noSrcSpanInfo = SrcSpan -> SrcSpanInfo
Hs.noInfoSpan (SrcLoc -> SrcLoc -> SrcSpan
Hs.mkSrcSpan SrcLoc
Hs.noLoc SrcLoc
Hs.noLoc)

{-
ghci> :i Module
data Module
  = Module SrcLoc
           ModuleName
           [OptionPragma]
           (Maybe WarningText)
           (Maybe [ExportSpec])
           [ImportDecl]
           [Decl]
        -- Defined in Language.Haskell.Exts.Syntax
instance Show Module -- Defined in Language.Haskell.Exts.Syntax
-}

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