{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module PureNix.Convert (convert, ModuleInfo (..)) where

import Data.Bitraversable
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Text.Internal.Search (indices)
import Language.PureScript (Ident (..))
import qualified Language.PureScript as P
import Language.PureScript.CoreFn
import Language.PureScript.Errors (SourceSpan)
import Language.PureScript.PSString (PSString (toUTF16CodeUnits))
import qualified PureNix.Expr as N
import qualified PureNix.Identifiers as N
import PureNix.Prelude

-- | The monad conversion runs in.
-- Conversion is per-module, which means that only the SourceSpan part of the ReaderT ever changes during conversion.
-- The StateT actually fuffills the role of a CPS'd WriterT.
type Convert = ReaderT (FilePath, P.ModuleName, SourceSpan) (State ModuleInfo)

-- | Represents the information collected about a module during conversion.
-- It is intended to be used in a WriterT-style fashion, which is why it has a 'Monoid' instance.
data ModuleInfo = ModuleInfo
  { -- | Whether the module has any FFI declarations.
    -- In the 'Monoid' instance, this behaves like an 'Data.Monoid.Any'.
    ModuleInfo -> Bool
usesFFI :: Bool,
    -- | Locations of strings that appear to perform string interpolation.
    ModuleInfo -> Set SourceSpan
interpolatedStrings :: Set SourceSpan
  }
  deriving (ModuleInfo -> ModuleInfo -> Bool
(ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool) -> Eq ModuleInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleInfo -> ModuleInfo -> Bool
$c/= :: ModuleInfo -> ModuleInfo -> Bool
== :: ModuleInfo -> ModuleInfo -> Bool
$c== :: ModuleInfo -> ModuleInfo -> Bool
Eq, Int -> ModuleInfo -> ShowS
[ModuleInfo] -> ShowS
ModuleInfo -> String
(Int -> ModuleInfo -> ShowS)
-> (ModuleInfo -> String)
-> ([ModuleInfo] -> ShowS)
-> Show ModuleInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleInfo] -> ShowS
$cshowList :: [ModuleInfo] -> ShowS
show :: ModuleInfo -> String
$cshow :: ModuleInfo -> String
showsPrec :: Int -> ModuleInfo -> ShowS
$cshowsPrec :: Int -> ModuleInfo -> ShowS
Show)

instance Semigroup ModuleInfo where ModuleInfo Bool
fa Set SourceSpan
ia <> :: ModuleInfo -> ModuleInfo -> ModuleInfo
<> ModuleInfo Bool
fb Set SourceSpan
ib = Bool -> Set SourceSpan -> ModuleInfo
ModuleInfo (Bool
fa Bool -> Bool -> Bool
|| Bool
fb) (Set SourceSpan
ia Set SourceSpan -> Set SourceSpan -> Set SourceSpan
forall a. Semigroup a => a -> a -> a
<> Set SourceSpan
ib)

instance Monoid ModuleInfo where mempty :: ModuleInfo
mempty = Bool -> Set SourceSpan -> ModuleInfo
ModuleInfo Bool
False Set SourceSpan
forall a. Monoid a => a
mempty

tell :: ModuleInfo -> Convert ()
tell :: ModuleInfo -> Convert ()
tell ModuleInfo
m = (ModuleInfo -> ModuleInfo) -> Convert ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ModuleInfo -> ModuleInfo -> ModuleInfo
forall a. Monoid a => a -> a -> a
mappend ModuleInfo
m)

-- | The central PureScript-to-Nix conversion function for a single PureScript module.
convert :: Module Ann -> (N.Expr, ModuleInfo)
convert :: Module Ann -> (Expr, ModuleInfo)
convert (Module SourceSpan
spn [Comment]
_comments ModuleName
name String
path [(Ann, ModuleName)]
imports [Ident]
exports Map ModuleName [Ident]
reexports [Ident]
foreign' [Bind Ann]
decls) =
  (State ModuleInfo Expr -> ModuleInfo -> (Expr, ModuleInfo))
-> ModuleInfo -> State ModuleInfo Expr -> (Expr, ModuleInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State ModuleInfo Expr -> ModuleInfo -> (Expr, ModuleInfo)
forall s a. State s a -> s -> (a, s)
runState ModuleInfo
forall a. Monoid a => a
mempty (State ModuleInfo Expr -> (Expr, ModuleInfo))
-> State ModuleInfo Expr -> (Expr, ModuleInfo)
forall a b. (a -> b) -> a -> b
$
    (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> (String, ModuleName, SourceSpan) -> State ModuleInfo Expr)
-> (String, ModuleName, SourceSpan)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> State ModuleInfo Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> (String, ModuleName, SourceSpan) -> State ModuleInfo Expr
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (String
path, ModuleName
name, SourceSpan
spn) (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> State ModuleInfo Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> State ModuleInfo Expr
forall a b. (a -> b) -> a -> b
$
      ModuleName
-> [(Ann, ModuleName)]
-> [Ident]
-> Map ModuleName [Ident]
-> [Ident]
-> [Bind Ann]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
module' ModuleName
name [(Ann, ModuleName)]
imports [Ident]
exports Map ModuleName [Ident]
reexports [Ident]
foreign' [Bind Ann]
decls

localSpan :: SourceSpan -> Convert a -> Convert a
localSpan :: SourceSpan -> Convert a -> Convert a
localSpan SourceSpan
spn = ((String, ModuleName, SourceSpan)
 -> (String, ModuleName, SourceSpan))
-> Convert a -> Convert a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((SourceSpan -> SourceSpan)
-> (String, ModuleName, SourceSpan)
-> (String, ModuleName, SourceSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SourceSpan -> SourceSpan)
 -> (String, ModuleName, SourceSpan)
 -> (String, ModuleName, SourceSpan))
-> (SourceSpan -> SourceSpan)
-> (String, ModuleName, SourceSpan)
-> (String, ModuleName, SourceSpan)
forall a b. (a -> b) -> a -> b
$ SourceSpan -> SourceSpan -> SourceSpan
forall a b. a -> b -> a
const SourceSpan
spn)

localAnn :: Ann -> Convert a -> Convert a
localAnn :: Ann -> Convert a -> Convert a
localAnn (SourceSpan
spn, [Comment]
_, Maybe SourceType
_, Maybe Meta
_) = SourceSpan -> Convert a -> Convert a
forall a. SourceSpan -> Convert a -> Convert a
localSpan SourceSpan
spn

{-# ANN module' ("hlint: ignore Use list comprehension" :: String) #-}
module' ::
  P.ModuleName ->
  [(Ann, P.ModuleName)] ->
  [Ident] ->
  Map P.ModuleName [Ident] ->
  [Ident] ->
  [Bind Ann] ->
  Convert N.Expr
module' :: ModuleName
-> [(Ann, ModuleName)]
-> [Ident]
-> Map ModuleName [Ident]
-> [Ident]
-> [Bind Ann]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
module' ModuleName
thisModule [(Ann, ModuleName)]
imports [Ident]
exports Map ModuleName [Ident]
reexports [Ident]
foreign' [Bind Ann]
decls = do
  let importBinding :: (Var, Expr)
importBinding =
        let attrs :: [(Key, Expr)]
attrs =
              [ (ModuleName -> Key
N.moduleKey ModuleName
mdl, Expr -> Expr -> Expr
N.app (Var -> Expr
N.var Var
"import") (Text -> Expr
N.path (Text
"../" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
P.runModuleName ModuleName
mdl)))
                | (Ann
_, ModuleName
mdl) <- [(Ann, ModuleName)]
imports,
                  ModuleName
mdl ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
thisModule,
                  ModuleName
mdl ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> ModuleName
P.ModuleName Text
"Prim"
              ]
         in (Var
"module", [Var] -> [(Expr, [Key])] -> [(Key, Expr)] -> Expr
N.attrs [] [] [(Key, Expr)]
attrs)
      ffiBinds :: [(Var, Expr)]
ffiBinds = Ident -> (Var, Expr)
foreignBinding (Ident -> (Var, Expr)) -> [Ident] -> [(Var, Expr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
foreign'
      expts :: [Var]
expts = Ident -> Var
N.mkVar (Ident -> Var) -> [Ident] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
exports
      reexpts :: [(Expr, [Key])]
reexpts = (ModuleName -> [Ident] -> (Expr, [Key]))
-> (ModuleName, [Ident]) -> (Expr, [Key])
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ModuleName -> [Ident] -> (Expr, [Key])
inheritFrom ((ModuleName, [Ident]) -> (Expr, [Key]))
-> [(ModuleName, [Ident])] -> [(Expr, [Key])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ModuleName [Ident] -> [(ModuleName, [Ident])]
forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName [Ident]
reexports
  [(Var, Expr)]
ffiFileBinding <-
    if [Ident] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
foreign'
      then [(Var, Expr)]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      else [(Var
"foreign", Expr -> Expr -> Expr
N.app (Var -> Expr
N.var Var
"import") (Text -> Expr
N.path Text
"./foreign.nix"))] [(Var, Expr)]
-> Convert ()
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ModuleInfo -> Convert ()
tell ModuleInfo
forall a. Monoid a => a
mempty {usesFFI :: Bool
usesFFI = Bool
True}
  [(Var, Expr)]
binds <- [Bind Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings [Bind Ann]
decls
  Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$
    [(Var, Expr)] -> Expr -> Expr
N.let'
      ((Var, Expr)
importBinding (Var, Expr) -> [(Var, Expr)] -> [(Var, Expr)]
forall a. a -> [a] -> [a]
: [(Var, Expr)]
ffiFileBinding [(Var, Expr)] -> [(Var, Expr)] -> [(Var, Expr)]
forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)]
ffiBinds [(Var, Expr)] -> [(Var, Expr)] -> [(Var, Expr)]
forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)]
binds)
      ([Var] -> [(Expr, [Key])] -> [(Key, Expr)] -> Expr
N.attrs [Var]
expts [(Expr, [Key])]
reexpts [(Key, Expr)]
forall a. Monoid a => a
mempty)
  where
    inheritFrom :: P.ModuleName -> [Ident] -> (N.Expr, [N.Key])
    inheritFrom :: ModuleName -> [Ident] -> (Expr, [Key])
inheritFrom ModuleName
m [Ident]
exps = (Expr -> Key -> Expr
N.sel (Var -> Expr
N.var Var
"module") (ModuleName -> Key
N.moduleKey ModuleName
m), Ident -> Key
N.identKey (Ident -> Key) -> [Ident] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
exps)

    foreignBinding :: Ident -> (N.Var, N.Expr)
    foreignBinding :: Ident -> (Var, Expr)
foreignBinding Ident
ffiIdent = (Ident -> Var
N.mkVar Ident
ffiIdent, Expr -> Key -> Expr
N.sel (Var -> Expr
N.var Var
"foreign") (Ident -> Key
N.identKey Ident
ffiIdent))

bindings :: [Bind Ann] -> Convert [(N.Var, N.Expr)]
bindings :: [Bind Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings = ((Ann, Ident, Expr Ann)
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr))
-> [(Ann, Ident, Expr Ann)]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Ann, Ident, Expr Ann)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
binding ([(Ann, Ident, Expr Ann)]
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)])
-> ([Bind Ann] -> [(Ann, Ident, Expr Ann)])
-> [Bind Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Bind Ann]
-> (Bind Ann -> [(Ann, Ident, Expr Ann)])
-> [(Ann, Ident, Expr Ann)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bind Ann -> [(Ann, Ident, Expr Ann)]
forall a. Bind a -> [(a, Ident, Expr a)]
flatten)
  where
    binding :: (Ann, Ident, Expr Ann) -> Convert (N.Var, N.Expr)
    binding :: (Ann, Ident, Expr Ann)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
binding (Ann
ann, Ident
i, Expr Ann
e) = Ann
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT
   (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr))
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
forall a b. (a -> b) -> a -> b
$ (Expr -> (Var, Expr))
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Var, Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident -> Var
N.mkVar Ident
i,) (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
e)
    flatten :: Bind a -> [(a, Ident, Expr a)]
    flatten :: Bind a -> [(a, Ident, Expr a)]
flatten (NonRec a
a Ident
i Expr a
e) = [(a
a, Ident
i, Expr a
e)]
    flatten (Rec [((a, Ident), Expr a)]
bs) = (\((a
a, Ident
i), Expr a
e) -> (a
a, Ident
i, Expr a
e)) (((a, Ident), Expr a) -> (a, Ident, Expr a))
-> [((a, Ident), Expr a)] -> [(a, Ident, Expr a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((a, Ident), Expr a)]
bs

expr :: Expr Ann -> Convert N.Expr
expr :: Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr (Abs Ann
ann Ident
arg Expr Ann
body) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var -> Expr -> Expr
N.lam (Ident -> Var
N.mkVar Ident
arg)) (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
body)
expr (Literal Ann
ann Literal (Expr Ann)
lit) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Literal (Expr Ann)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
literal Literal (Expr Ann)
lit
-- Newtype wrappers can always be removed.
expr (App Ann
ann (Var (SourceSpan
_, [Comment]
_, Maybe SourceType
_, Just Meta
IsNewtype) Qualified Ident
_) Expr Ann
x) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
x)
expr (App Ann
ann Expr Ann
f Expr Ann
x) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Expr -> Expr -> Expr
N.app (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
f) (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
x)
expr (Var Ann
ann (P.Qualified Maybe ModuleName
mqual Ident
name)) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ do
  (String
_, ModuleName
thisModule, SourceSpan
_) <- ReaderT
  (String, ModuleName, SourceSpan)
  (State ModuleInfo)
  (String, ModuleName, SourceSpan)
forall r (m :: * -> *). MonadReader r m => m r
ask
  Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ case Maybe ModuleName
mqual of
    Just ModuleName
qual
      | ModuleName
qual ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
/= ModuleName
thisModule -> Expr -> Key -> Expr
N.sel (Expr -> Key -> Expr
N.sel (Var -> Expr
N.var Var
"module") (ModuleName -> Key
N.moduleKey ModuleName
qual)) (Ident -> Key
N.identKey Ident
name)
    Maybe ModuleName
_ -> Var -> Expr
N.var (Ident -> Var
N.mkVar Ident
name)
expr (Accessor Ann
ann PSString
sel Expr Ann
body) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Key -> Expr) -> Key -> Expr -> Expr
forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Key -> Expr
N.sel (PSString -> Key
N.stringKey PSString
sel) (Expr -> Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
body
expr (Let Ann
ann [Bind Ann]
binds Expr Ann
body) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ ([(Var, Expr)] -> Expr -> Expr)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [(Var, Expr)] -> Expr -> Expr
N.let' ([Bind Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings [Bind Ann]
binds) (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
body)
expr (ObjectUpdate Ann
ann Expr Ann
a [(PSString, Expr Ann)]
b) = Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Op -> Expr -> Expr -> Expr
N.bin Op
N.Update) (Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
a) ([(PSString, Expr Ann)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
attrs [(PSString, Expr Ann)]
b)
expr (Constructor Ann
_ ProperName 'TypeName
_ (P.ProperName Text
dataName) [Ident]
fields) = Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Text -> [Var] -> Expr
N.constructor Text
dataName (Ident -> Var
N.mkVar (Ident -> Var) -> [Ident] -> [Var]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
fields)
expr (Case Ann
ann [Expr Ann]
exprs [CaseAlternative Ann]
cases) =
  Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ do
    [Expr]
exprs' <- (Expr Ann
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> [Expr Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr [Expr Ann]
exprs
    [Expr]
cases' <- (CaseAlternative Ann
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> [CaseAlternative Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Expr]
-> CaseAlternative Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
alternative [Expr]
exprs') [CaseAlternative Ann]
cases
    (String
fp, ModuleName
_, SourceSpan
spn) <- ReaderT
  (String, ModuleName, SourceSpan)
  (State ModuleInfo)
  (String, ModuleName, SourceSpan)
forall r (m :: * -> *). MonadReader r m => m r
ask
    let patternCases :: [(Var, Expr)]
patternCases = [Var] -> [Expr] -> [(Var, Expr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Text -> [Var]
N.numberedVars Text
"__pattern") [Expr]
cases'
        patternFail :: (Var, Expr)
patternFail =
          ( Var
"__patternFail",
            Expr -> Expr -> Expr
N.app
              (Key -> Expr
N.builtin Key
"throw")
              (Text -> Expr
N.string (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"Pattern match failure in ", String -> Text
T.pack String
fp, Text
" at ", SourceSpan -> Text
P.displayStartEndPosShort SourceSpan
spn])
          )
        patterns :: [(Var, Expr)]
patterns = [(Var, Expr)]
patternCases [(Var, Expr)] -> [(Var, Expr)] -> [(Var, Expr)]
forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)
patternFail]
    Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$
      [(Var, Expr)] -> Expr -> Expr
N.let'
        [(Var, Expr)]
patterns
        ((Expr -> Expr -> Expr) -> [Expr] -> Expr
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expr -> Expr -> Expr
N.app (Var -> Expr
N.var (Var -> Expr) -> ((Var, Expr) -> Var) -> (Var, Expr) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, Expr) -> Var
forall a b. (a, b) -> a
fst ((Var, Expr) -> Expr) -> [(Var, Expr)] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, Expr)]
patterns))

-- | Generates a matcher for a given case alternative, against the given list of scrutinees.
-- A matcher takes a failure continuation, and either calls the expression body with the matched names in scope, or if the matcher fails, the failure continutation.
alternative :: [N.Expr] -> CaseAlternative Ann -> Convert N.Expr
alternative :: [Expr]
-> CaseAlternative Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
alternative [Expr]
scrutinees = CaseAlternative Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
go
  where
    go :: CaseAlternative Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
go (CaseAlternative [Binder Ann]
binders Either [(Expr Ann, Expr Ann)] (Expr Ann)
body) = do
      ([Expr]
patternChecks, [(Var, Expr)]
patternBinds) <- [Expr] -> [Binder Ann] -> Convert ([Expr], [(Var, Expr)])
zipBinders [Expr]
scrutinees [Binder Ann]
binders
      Expr
body' <- Either [(Expr Ann, Expr Ann)] (Expr Ann)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
unguard Either [(Expr Ann, Expr Ann)] (Expr Ann)
body (Var -> Expr
N.var Var
"__fail")
      Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$
        Var -> Expr -> Expr
N.lam Var
"__fail" (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$
          case [Expr]
patternChecks of
            [] -> [(Var, Expr)] -> Expr -> Expr
N.let' [(Var, Expr)]
patternBinds Expr
body'
            [Expr]
_ ->
              Expr -> Expr -> Expr -> Expr
N.cond
                ((Expr -> Expr -> Expr) -> [Expr] -> Expr
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (Op -> Expr -> Expr -> Expr
N.bin Op
N.And) [Expr]
patternChecks)
                ([(Var, Expr)] -> Expr -> Expr
N.let' [(Var, Expr)]
patternBinds Expr
body')
                (Var -> Expr
N.var Var
"__fail")

-- | Generates a matcher (see 'alternative') for a potentially guarded 'CaseAlternative' body.
-- For guards, we test every guard in order with the failure continuation as the final case.
unguard :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> N.Expr -> Convert N.Expr
unguard :: Either [(Expr Ann, Expr Ann)] (Expr Ann)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
unguard (Right Expr Ann
body) Expr
_ = Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
body
unguard (Left [(Expr Ann, Expr Ann)]
guardedBodies) Expr
failCase = do
  [(Expr, Expr)]
guardedBodies' <- ((Expr Ann, Expr Ann)
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) (Expr, Expr))
-> [(Expr Ann, Expr Ann)]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Expr, Expr)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr Ann
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> (Expr Ann
    -> ReaderT
         (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> (Expr Ann, Expr Ann)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Expr, Expr)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr) [(Expr Ann, Expr Ann)]
guardedBodies
  Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ ((Expr, Expr) -> Expr -> Expr) -> Expr -> [(Expr, Expr)] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Expr -> Expr -> Expr -> Expr) -> (Expr, Expr) -> Expr -> Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Expr -> Expr -> Expr -> Expr
N.cond) Expr
failCase [(Expr, Expr)]
guardedBodies'

zipBinders :: [N.Expr] -> [Binder Ann] -> Convert ([N.Expr], [(N.Var, N.Expr)])
zipBinders :: [Expr] -> [Binder Ann] -> Convert ([Expr], [(Var, Expr)])
zipBinders [Expr]
exprs [Binder Ann]
binds = [([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)])
forall a. Monoid a => [a] -> a
mconcat ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)]))
-> [Binder Ann]
-> [Expr]
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder [Binder Ann]
binds [Expr]
exprs

-- | Turns a binder(/pattern) and a scrutinee into a pair of
--   - boolean expressions, that all return true iff the pattern applies
--   - the bindings produced by the pattern
unbinder :: Binder Ann -> N.Expr -> Convert ([N.Expr], [(N.Var, N.Expr)])
unbinder :: Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder (NullBinder Ann
_) Expr
_ = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr], [(Var, Expr)])
forall a. Monoid a => a
mempty
unbinder (VarBinder Ann
_ Ident
name) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)]))
-> ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall a b. (a -> b) -> a -> b
$ (\Var
name' -> ([], [(Var
name', Expr
scrut)])) (Var -> ([Expr], [(Var, Expr)])) -> Var -> ([Expr], [(Var, Expr)])
forall a b. (a -> b) -> a -> b
$ Ident -> Var
N.mkVar Ident
name
unbinder (ConstructorBinder (SourceSpan
_, [Comment]
_, Maybe SourceType
_, Just Meta
IsNewtype) Qualified (ProperName 'TypeName)
_ Qualified (ProperName 'ConstructorName)
_ [Binder Ann
field]) Expr
scrut = Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder Binder Ann
field Expr
scrut
unbinder (ConstructorBinder Ann
ann Qualified (ProperName 'TypeName)
_ (P.Qualified Maybe ModuleName
_ (P.ProperName Text
tag)) [Binder Ann]
fields) Expr
scrut =
  Ann
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (Convert ([Expr], [(Var, Expr)])
 -> Convert ([Expr], [(Var, Expr)]))
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a b. (a -> b) -> a -> b
$
    ([Expr], [(Var, Expr)])
-> ([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)])
forall a. Monoid a => a -> a -> a
mappend ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals (Expr -> Key -> Expr
N.sel Expr
scrut Key
"__tag") (Text -> Expr
N.string Text
tag)], []) (([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)]))
-> ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> [([Expr], [(Var, Expr)])]
-> ([Expr], [(Var, Expr)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)])
forall a. Monoid a => [a] -> a
mconcat ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Binder Ann -> Key -> Convert ([Expr], [(Var, Expr)]))
-> [Binder Ann]
-> [Key]
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Binder Ann
binder Key
field -> Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder Binder Ann
binder (Expr -> Key -> Expr
N.sel Expr
scrut Key
field)) [Binder Ann]
fields (Text -> [Key]
N.numberedKeys Text
"__field")
unbinder (NamedBinder Ann
ann Ident
name Binder Ann
binder) Expr
scrut = Ann
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (Convert ([Expr], [(Var, Expr)])
 -> Convert ([Expr], [(Var, Expr)]))
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a b. (a -> b) -> a -> b
$ do
  ([Expr], [(Var, Expr)])
-> ([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)])
forall a. Monoid a => a -> a -> a
mappend ([], [(Ident -> Var
N.mkVar Ident
name, Expr
scrut)]) (([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)]))
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder Binder Ann
binder Expr
scrut
unbinder (LiteralBinder Ann
ann Literal (Binder Ann)
lit) Expr
scrut' = Ann
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (Convert ([Expr], [(Var, Expr)])
 -> Convert ([Expr], [(Var, Expr)]))
-> Convert ([Expr], [(Var, Expr)])
-> Convert ([Expr], [(Var, Expr)])
forall a b. (a -> b) -> a -> b
$ Literal (Binder Ann) -> Expr -> Convert ([Expr], [(Var, Expr)])
litBinder Literal (Binder Ann)
lit Expr
scrut'
  where
    litBinder :: Literal (Binder Ann) -> N.Expr -> Convert ([N.Expr], [(N.Var, N.Expr)])
    litBinder :: Literal (Binder Ann) -> Expr -> Convert ([Expr], [(Var, Expr)])
litBinder (NumericLiteral (Left Integer
n)) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals Expr
scrut (Integer -> Expr
N.int Integer
n)], [])
    litBinder (NumericLiteral (Right Double
x)) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals Expr
scrut (Double -> Expr
N.double Double
x)], [])
    litBinder (StringLiteral PSString
str) Expr
scrut = (\Text
str' -> ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals Expr
scrut (Text -> Expr
N.string Text
str')], [])) (Text -> ([Expr], [(Var, Expr)]))
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSString
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
string PSString
str
    litBinder (CharLiteral Char
char) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals Expr
scrut (Text -> Expr
N.string (Char -> Text
T.singleton Char
char))], [])
    litBinder (BooleanLiteral Bool
True) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr
scrut], [])
    litBinder (BooleanLiteral Bool
False) Expr
scrut = ([Expr], [(Var, Expr)]) -> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr -> Expr
N.not' Expr
scrut], [])
    litBinder (ArrayLiteral [Binder Ann]
as) Expr
scrut =
      ([Expr], [(Var, Expr)])
-> ([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)])
forall a. Monoid a => a -> a -> a
mappend ([Op -> Expr -> Expr -> Expr
N.bin Op
N.Equals (Expr -> Expr -> Expr
N.app (Key -> Expr
N.builtin Key
"length") Expr
scrut) (Integer -> Expr
N.int (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))], []) (([Expr], [(Var, Expr)]) -> ([Expr], [(Var, Expr)]))
-> ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> [([Expr], [(Var, Expr)])]
-> ([Expr], [(Var, Expr)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)])
forall a. Monoid a => [a] -> a
mconcat
        ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Binder Ann -> Integer -> Convert ([Expr], [(Var, Expr)]))
-> [Binder Ann]
-> [Integer]
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Binder Ann
binder Integer
ix -> Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder Binder Ann
binder (Expr -> Integer -> Expr
elemAt Expr
scrut Integer
ix)) [Binder Ann]
as [Integer
0 :: Integer ..]
      where
        n :: Int
n = [Binder Ann] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Binder Ann]
as
        elemAt :: Expr -> Integer -> Expr
elemAt Expr
list Integer
ix = Expr -> Expr -> Expr
N.app (Expr -> Expr -> Expr
N.app (Key -> Expr
N.builtin Key
"elemAt") Expr
list) (Integer -> Expr
N.int Integer
ix)
    litBinder (ObjectLiteral [(PSString, Binder Ann)]
fields) Expr
scrut = [([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)])
forall a. Monoid a => [a] -> a
mconcat ([([Expr], [(Var, Expr)])] -> ([Expr], [(Var, Expr)]))
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
-> Convert ([Expr], [(Var, Expr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PSString, Binder Ann) -> Convert ([Expr], [(Var, Expr)]))
-> [(PSString, Binder Ann)]
-> ReaderT
     (String, ModuleName, SourceSpan)
     (State ModuleInfo)
     [([Expr], [(Var, Expr)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(PSString
field, Binder Ann
binder) -> Binder Ann -> Expr -> Convert ([Expr], [(Var, Expr)])
unbinder Binder Ann
binder (Expr -> Key -> Expr
N.sel Expr
scrut (PSString -> Key
N.stringKey PSString
field))) [(PSString, Binder Ann)]
fields

attrs :: [(PSString, Expr Ann)] -> Convert N.Expr
attrs :: [(PSString, Expr Ann)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
attrs = ([(Key, Expr)] -> Expr)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Key, Expr)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Var] -> [(Expr, [Key])] -> [(Key, Expr)] -> Expr
N.attrs [] []) (ReaderT
   (String, ModuleName, SourceSpan) (State ModuleInfo) [(Key, Expr)]
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> ([(PSString, Expr Ann)]
    -> ReaderT
         (String, ModuleName, SourceSpan) (State ModuleInfo) [(Key, Expr)])
-> [(PSString, Expr Ann)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PSString, Expr Ann)
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr))
-> [(PSString, Expr Ann)]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [(Key, Expr)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PSString, Expr Ann)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr)
attr
  where
    attr :: (PSString, Expr Ann)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr)
attr (PSString
string, Expr Ann
body) = (PSString -> Key
N.stringKey PSString
string,) (Expr -> (Key, Expr))
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr Expr Ann
body

string :: PSString -> Convert Text
string :: PSString
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
string PSString
str = do
  let decoded :: Text
decoded = String -> Text
T.pack (String -> Text) -> (PSString -> String) -> PSString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Char) -> [Word16] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word16 -> Int) -> Word16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word16] -> String)
-> (PSString -> [Word16]) -> PSString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSString -> [Word16]
toUTF16CodeUnits (PSString -> Text) -> PSString -> Text
forall a b. (a -> b) -> a -> b
$ PSString
str
  Bool -> Convert () -> Convert ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
mightContainInterpolation Text
decoded) (Convert () -> Convert ()) -> Convert () -> Convert ()
forall a b. (a -> b) -> a -> b
$ do
    (String
_, ModuleName
_, SourceSpan
spn) <- ReaderT
  (String, ModuleName, SourceSpan)
  (State ModuleInfo)
  (String, ModuleName, SourceSpan)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ModuleInfo -> Convert ()
tell ModuleInfo
forall a. Monoid a => a
mempty {interpolatedStrings :: Set SourceSpan
interpolatedStrings = SourceSpan -> Set SourceSpan
forall a. a -> Set a
S.singleton SourceSpan
spn}
  Text
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
decoded
  where
    -- Performs a _very_ rudimentary check for interpolation:
    -- Simply checks if "${" occurs in the string, and if so, there's a "}" occurring later in the string.
    -- This does not account for any possible escaping/quoting.
    mightContainInterpolation :: Text -> Bool
    mightContainInterpolation :: Text -> Bool
mightContainInterpolation Text
t = case Text -> Text -> [Int]
indices Text
"${" Text
t of
      [] -> Bool
False
      (Int
ixOpen : [Int]
_) -> (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ixOpen) ([Int] -> Bool) -> [Int] -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Int]
indices Text
"}" Text
t

literal :: Literal (Expr Ann) -> Convert N.Expr
literal :: Literal (Expr Ann)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
literal (NumericLiteral (Left Integer
n)) = Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Integer -> Expr
N.int Integer
n
literal (NumericLiteral (Right Double
n)) = Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Double -> Expr
N.double Double
n
literal (StringLiteral PSString
str) = Text -> Expr
N.string (Text -> Expr)
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSString
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Text
string PSString
str
literal (CharLiteral Char
chr) = Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Text -> Expr
N.string (Text -> Expr) -> Text -> Expr
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
chr
literal (BooleanLiteral Bool
b) = Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> Expr
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Bool -> Expr
forall a. a -> a -> Bool -> a
bool (Var -> Expr
N.var Var
"false") (Var -> Expr
N.var Var
"true") Bool
b
literal (ArrayLiteral [Expr Ann]
arr) = [Expr] -> Expr
N.list ([Expr] -> Expr)
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [Expr]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr Ann
 -> ReaderT
      (String, ModuleName, SourceSpan) (State ModuleInfo) Expr)
-> [Expr Ann]
-> ReaderT
     (String, ModuleName, SourceSpan) (State ModuleInfo) [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Ann
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
expr [Expr Ann]
arr
literal (ObjectLiteral [(PSString, Expr Ann)]
obj) = [(PSString, Expr Ann)]
-> ReaderT (String, ModuleName, SourceSpan) (State ModuleInfo) Expr
attrs [(PSString, Expr Ann)]
obj