module Morley.Michelson.Parser.Types
( Parser
, MichelsonSource (.., MSStdin, MSCli)
, codeSrc
) where
import Fmt (Buildable(..))
import GHC.Stack (SrcLoc(..))
import Text.Megaparsec (Parsec)
import Morley.Michelson.Parser.Error
type Parser = Parsec CustomParserException Text
data ParserOptions = ParserOptions
{ ParserOptions -> Bool
poMorleyExts :: Bool
} deriving stock (Int -> ParserOptions -> ShowS
[ParserOptions] -> ShowS
ParserOptions -> String
(Int -> ParserOptions -> ShowS)
-> (ParserOptions -> String)
-> ([ParserOptions] -> ShowS)
-> Show ParserOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserOptions -> ShowS
showsPrec :: Int -> ParserOptions -> ShowS
$cshow :: ParserOptions -> String
show :: ParserOptions -> String
$cshowList :: [ParserOptions] -> ShowS
showList :: [ParserOptions] -> ShowS
Show, ParserOptions -> ParserOptions -> Bool
(ParserOptions -> ParserOptions -> Bool)
-> (ParserOptions -> ParserOptions -> Bool) -> Eq ParserOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParserOptions -> ParserOptions -> Bool
== :: ParserOptions -> ParserOptions -> Bool
$c/= :: ParserOptions -> ParserOptions -> Bool
/= :: ParserOptions -> ParserOptions -> Bool
Eq)
data MichelsonSource
= MSFile FilePath
| MSName Text
| MSCode SrcLoc
| MSUnspecified
deriving stock (Int -> MichelsonSource -> ShowS
[MichelsonSource] -> ShowS
MichelsonSource -> String
(Int -> MichelsonSource -> ShowS)
-> (MichelsonSource -> String)
-> ([MichelsonSource] -> ShowS)
-> Show MichelsonSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MichelsonSource -> ShowS
showsPrec :: Int -> MichelsonSource -> ShowS
$cshow :: MichelsonSource -> String
show :: MichelsonSource -> String
$cshowList :: [MichelsonSource] -> ShowS
showList :: [MichelsonSource] -> ShowS
Show, MichelsonSource -> MichelsonSource -> Bool
(MichelsonSource -> MichelsonSource -> Bool)
-> (MichelsonSource -> MichelsonSource -> Bool)
-> Eq MichelsonSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MichelsonSource -> MichelsonSource -> Bool
== :: MichelsonSource -> MichelsonSource -> Bool
$c/= :: MichelsonSource -> MichelsonSource -> Bool
/= :: MichelsonSource -> MichelsonSource -> Bool
Eq)
pattern MSStdin :: MichelsonSource
pattern $mMSStdin :: forall {r}. MichelsonSource -> ((# #) -> r) -> ((# #) -> r) -> r
$bMSStdin :: MichelsonSource
MSStdin = MSName "<stdin>"
pattern MSCli :: MichelsonSource
pattern $mMSCli :: forall {r}. MichelsonSource -> ((# #) -> r) -> ((# #) -> r) -> r
$bMSCli :: MichelsonSource
MSCli = MSName "<cli>"
instance IsString MichelsonSource where
fromString :: String -> MichelsonSource
fromString = Text -> MichelsonSource
MSName (Text -> MichelsonSource)
-> (String -> Text) -> String -> MichelsonSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
{-# ANN module ("HLint: ignore Use 'callStack' from Universum" :: Text) #-}
{-# ANN module ("HLint: ignore Use 'getCallStack' from Universum" :: Text) #-}
codeSrc :: HasCallStack => MichelsonSource
codeSrc :: HasCallStack => MichelsonSource
codeSrc = SrcLoc -> MichelsonSource
MSCode (SrcLoc -> MichelsonSource) -> SrcLoc -> MichelsonSource
forall a b. (a -> b) -> a -> b
$
case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack) of
[] -> Text -> SrcLoc
forall a. HasCallStack => Text -> a
error Text
"Unexpectedly empty callstack"
(String
_funName, SrcLoc
srcLoc) : [(String, SrcLoc)]
_ -> SrcLoc
srcLoc
instance Buildable MichelsonSource where
build :: MichelsonSource -> Doc
build = \case
MSFile String
file -> String -> Doc
forall a. Buildable a => a -> Doc
build String
file
MichelsonSource
MSStdin -> Doc
"<user input>"
MichelsonSource
MSCli -> Doc
"<user input via CLI>"
MSName Text
name -> Text -> Doc
forall a. Buildable a => a -> Doc
build Text
name
MSCode SrcLoc{Int
String
srcLocPackage :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
..} ->
String -> Doc
forall a. Buildable a => a -> Doc
build String
srcLocFile Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. Buildable a => a -> Doc
build Int
srcLocStartLine Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
":" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall a. Buildable a => a -> Doc
build Int
srcLocStartCol
MichelsonSource
MSUnspecified -> Doc
""