module Fay.Compiler.Parse
  ( parseFay
  , defaultExtensions
  ) where

import           Language.Haskell.Exts

-- | Parse some Fay code.
parseFay :: Parseable ast => FilePath -> String -> ParseResult ast
parseFay :: FilePath -> FilePath -> ParseResult ast
parseFay FilePath
filepath = ParseMode -> FilePath -> ParseResult ast
forall ast.
Parseable ast =>
ParseMode -> FilePath -> ParseResult ast
parseWithMode ParseMode
parseMode { parseFilename :: FilePath
parseFilename = FilePath
filepath } (FilePath -> ParseResult ast)
-> (FilePath -> FilePath) -> FilePath -> ParseResult ast
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
applyCPP

-- | Apply incredibly simplistic CPP handling. It only recognizes the following:
--
-- > #if FAY
-- > #ifdef FAY
-- > #ifndef FAY
-- > #else
-- > #endif
--
-- Note that this implementation replaces all removed lines with blanks, so
-- that line numbers remain accurate.
applyCPP :: String -> String
applyCPP :: FilePath -> FilePath
applyCPP =
    [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPPState -> [FilePath] -> [FilePath]
loop CPPState
NoCPP ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
  where
    loop :: CPPState -> [FilePath] -> [FilePath]
loop CPPState
_ [] = []
    loop CPPState
state' (FilePath
"#if FAY":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop (Bool -> CPPState -> CPPState
CPPIf Bool
True CPPState
state') [FilePath]
rest
    loop CPPState
state' (FilePath
"#ifdef FAY":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop (Bool -> CPPState -> CPPState
CPPIf Bool
True CPPState
state') [FilePath]
rest
    loop CPPState
state' (FilePath
"#ifndef FAY":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop (Bool -> CPPState -> CPPState
CPPIf Bool
False CPPState
state') [FilePath]
rest
    loop (CPPIf Bool
b CPPState
oldState') (FilePath
"#else":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop (Bool -> CPPState -> CPPState
CPPElse (Bool -> Bool
not Bool
b) CPPState
oldState') [FilePath]
rest
    loop (CPPIf Bool
_ CPPState
oldState') (FilePath
"#endif":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop CPPState
oldState' [FilePath]
rest
    loop (CPPElse Bool
_ CPPState
oldState') (FilePath
"#endif":[FilePath]
rest) = FilePath
"" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop CPPState
oldState' [FilePath]
rest
    loop CPPState
state' (FilePath
x:[FilePath]
rest) = (if CPPState -> Bool
toInclude CPPState
state' then FilePath
x else FilePath
"") FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CPPState -> [FilePath] -> [FilePath]
loop CPPState
state' [FilePath]
rest

    toInclude :: CPPState -> Bool
toInclude CPPState
NoCPP = Bool
True
    toInclude (CPPIf Bool
x CPPState
state') = Bool
x Bool -> Bool -> Bool
&& CPPState -> Bool
toInclude CPPState
state'
    toInclude (CPPElse Bool
x CPPState
state') = Bool
x Bool -> Bool -> Bool
&& CPPState -> Bool
toInclude CPPState
state'

-- | The CPP's parsing state.
data CPPState = NoCPP
              | CPPIf Bool CPPState
              | CPPElse Bool CPPState

-- | The parse mode for Fay.
parseMode :: ParseMode
parseMode :: ParseMode
parseMode = ParseMode
defaultParseMode
  { extensions :: [Extension]
extensions = [Extension]
defaultExtensions
  , fixities :: Maybe [Fixity]
fixities = [Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just ([Fixity]
preludeFixities [Fixity] -> [Fixity] -> [Fixity]
forall a. [a] -> [a] -> [a]
++ [Fixity]
baseFixities)
  }

defaultExtensions :: [Extension]
defaultExtensions :: [Extension]
defaultExtensions = (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension
  [KnownExtension
EmptyDataDecls
  ,KnownExtension
ExistentialQuantification
  ,KnownExtension
FlexibleContexts
  ,KnownExtension
FlexibleInstances
  ,KnownExtension
GADTs
  ,KnownExtension
ImplicitPrelude
  ,KnownExtension
KindSignatures
  ,KnownExtension
LambdaCase
  ,KnownExtension
MultiWayIf
  ,KnownExtension
NamedFieldPuns
  ,KnownExtension
PackageImports
  ,KnownExtension
RecordWildCards
  ,KnownExtension
StandaloneDeriving
  ,KnownExtension
TupleSections
  ,KnownExtension
TypeFamilies
  ,KnownExtension
TypeOperators
  ]