{-# 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
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 -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModuleInfo] -> ShowS
$cshowList :: [ModuleInfo] -> ShowS
show :: ModuleInfo -> FilePath
$cshow :: ModuleInfo -> FilePath
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 forall a. Semigroup a => a -> a -> a
<> Set SourceSpan
ib)

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

tell :: ModuleInfo -> Convert ()
tell :: ModuleInfo -> Convert ()
tell ModuleInfo
m = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (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 FilePath
path [(Ann, ModuleName)]
imports [Ident]
exports Map ModuleName [Ident]
reexports [Ident]
foreign' [Bind Ann]
decls) =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (FilePath
path, ModuleName
name, SourceSpan
spn) forall a b. (a -> b) -> a -> b
$
      ModuleName
-> [(Ann, ModuleName)]
-> [Ident]
-> Map ModuleName [Ident]
-> [Ident]
-> [Bind Ann]
-> Convert 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 :: forall a. SourceSpan -> Convert a -> Convert a
localSpan SourceSpan
spn = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const SourceSpan
spn)

localAnn :: Ann -> Convert a -> Convert a
localAnn :: forall a. Ann -> Convert a -> Convert a
localAnn (SourceSpan
spn, [Comment]
_, Maybe SourceType
_, Maybe Meta
_) = 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]
-> Convert 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
"../" forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
P.runModuleName ModuleName
mdl)))
                | (Ann
_, ModuleName
mdl) <- [(Ann, ModuleName)]
imports,
                  ModuleName
mdl forall a. Eq a => a -> a -> Bool
/= ModuleName
thisModule,
                  ModuleName
mdl 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
foreign'
      expts :: [Var]
expts = Ident -> Var
N.mkVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
exports
      reexpts :: [(Expr, [Key])]
reexpts = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ModuleName -> [Ident] -> (Expr, [Key])
inheritFrom forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName [Ident]
reexports
  [(Var, Expr)]
ffiFileBinding <-
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Ident]
foreign'
      then 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"))] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ModuleInfo -> Convert ()
tell forall a. Monoid a => a
mempty {usesFFI :: Bool
usesFFI = Bool
True}
  [(Var, Expr)]
binds <- [Bind Ann]
-> ReaderT
     (FilePath, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings [Bind Ann]
decls
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    [(Var, Expr)] -> Expr -> Expr
N.let'
      ((Var, Expr)
importBinding forall a. a -> [a] -> [a]
: [(Var, Expr)]
ffiFileBinding forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)]
ffiBinds forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)]
binds)
      ([Var] -> [(Expr, [Key])] -> [(Key, Expr)] -> Expr
N.attrs [Var]
expts [(Expr, [Key])]
reexpts 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 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
     (FilePath, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Ann, Ident, Expr Ann) -> Convert (Var, Expr)
binding forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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) -> Convert (Var, Expr)
binding (Ann
ann, Ident
i, Expr Ann
e) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident -> Var
N.mkVar Ident
i,) (Expr Ann -> Convert Expr
expr Expr Ann
e)
    flatten :: Bind a -> [(a, Ident, Expr a)]
    flatten :: forall a. 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)) 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 -> Convert Expr
expr (Abs Ann
ann Ident
arg Expr Ann
body) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ 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 -> Convert Expr
expr Expr Ann
body)
expr (Literal Ann
ann Literal (Expr Ann)
lit) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ Literal (Expr Ann) -> Convert 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) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann (Expr Ann -> Convert Expr
expr Expr Ann
x)
expr (App Ann
ann Expr Ann
f Expr Ann
x) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Expr -> Expr -> Expr
N.app (Expr Ann -> Convert Expr
expr Expr Ann
f) (Expr Ann -> Convert Expr
expr Expr Ann
x)
expr (Var Ann
ann (P.Qualified QualifiedBy
mqual Ident
name)) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ do
  (FilePath
_, ModuleName
thisModule, SourceSpan
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case QualifiedBy
mqual of
    P.ByModuleName ModuleName
qual
      | ModuleName
qual 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)
    QualifiedBy
_ -> Var -> Expr
N.var (Ident -> Var
N.mkVar Ident
name)
expr (Accessor Ann
ann PSString
sel Expr Ann
body) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip Expr -> Key -> Expr
N.sel (PSString -> Key
N.stringKey PSString
sel) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Convert Expr
expr Expr Ann
body
expr (Let Ann
ann [Bind Ann]
binds Expr Ann
body) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ 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
     (FilePath, ModuleName, SourceSpan) (State ModuleInfo) [(Var, Expr)]
bindings [Bind Ann]
binds) (Expr Ann -> Convert Expr
expr Expr Ann
body)
expr (ObjectUpdate Ann
ann Expr Ann
a [(PSString, Expr Ann)]
b) = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ 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 -> Convert Expr
expr Expr Ann
a) ([(PSString, Expr Ann)] -> Convert Expr
attrs [(PSString, Expr Ann)]
b)
expr (Constructor Ann
_ ProperName 'TypeName
_ (P.ProperName Text
dataName) [Ident]
fields) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> [Var] -> Expr
N.constructor Text
dataName (Ident -> Var
N.mkVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
fields)
expr (Case Ann
ann [Expr Ann]
exprs [CaseAlternative Ann]
cases) =
  forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ do
    [Expr]
exprs' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Ann -> Convert Expr
expr [Expr Ann]
exprs
    [Expr]
cases' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ([Expr] -> CaseAlternative Ann -> Convert Expr
alternative [Expr]
exprs') [CaseAlternative Ann]
cases
    (FilePath
fp, ModuleName
_, SourceSpan
spn) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let patternCases :: [(Var, Expr)]
patternCases = 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 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"Pattern match failure in ", FilePath -> Text
T.pack FilePath
fp, Text
" at ", SourceSpan -> Text
P.displayStartEndPosShort SourceSpan
spn])
          )
        patterns :: [(Var, Expr)]
patterns = [(Var, Expr)]
patternCases forall a. Semigroup a => a -> a -> a
<> [(Var, Expr)
patternFail]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      [(Var, Expr)] -> Expr -> Expr
N.let'
        [(Var, Expr)]
patterns
        (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Expr -> Expr -> Expr
N.app (Var -> Expr
N.var forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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 -> Convert Expr
alternative [Expr]
scrutinees = CaseAlternative Ann -> Convert Expr
go
  where
    go :: CaseAlternative Ann -> Convert 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 -> Convert Expr
unguard Either [(Expr Ann, Expr Ann)] (Expr Ann)
body (Var -> Expr
N.var Var
"__fail")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Var -> Expr -> Expr
N.lam Var
"__fail" 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
                (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 -> Convert Expr
unguard (Right Expr Ann
body) Expr
_ = Expr Ann -> Convert Expr
expr Expr Ann
body
unguard (Left [(Expr Ann, Expr Ann)]
guardedBodies) Expr
failCase = do
  [(Expr, Expr)]
guardedBodies' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 -> Convert Expr
expr Expr Ann -> Convert Expr
expr) [(Expr Ann, Expr Ann)]
guardedBodies
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (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 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
unbinder (VarBinder Ann
_ Ident
name) Expr
scrut = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (\Var
name' -> ([], [(Var
name', Expr
scrut)])) 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 QualifiedBy
_ (P.ProperName Text
tag)) [Binder Ann]
fields) Expr
scrut =
  forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$
    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)], []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann forall a b. (a -> b) -> a -> b
$ do
  forall a. Monoid a => a -> a -> a
mappend ([], [(Ident -> Var
N.mkVar Ident
name, Expr
scrut)]) 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' = forall a. Ann -> Convert a -> Convert a
localAnn Ann
ann 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 = 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 = 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')], [])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSString -> Convert Text
string PSString
str
    litBinder (CharLiteral Char
char) Expr
scrut = 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr
scrut], [])
    litBinder (BooleanLiteral Bool
False) Expr
scrut = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr -> Expr
N.not' Expr
scrut], [])
    litBinder (ArrayLiteral [Binder Ann]
as) Expr
scrut =
      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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))], []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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 = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)] -> Convert Expr
attrs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Var] -> [(Expr, [Key])] -> [(Key, Expr)] -> Expr
N.attrs [] []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PSString, Expr Ann)
-> ReaderT
     (FilePath, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr)
attr
  where
    attr :: (PSString, Expr Ann)
-> ReaderT
     (FilePath, ModuleName, SourceSpan) (State ModuleInfo) (Key, Expr)
attr (PSString
string, Expr Ann
body) = (PSString -> Key
N.stringKey PSString
string,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Convert Expr
expr Expr Ann
body

string :: PSString -> Convert Text
string :: PSString -> Convert Text
string PSString
str = do
  let decoded :: Text
decoded = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSString -> [Word16]
toUTF16CodeUnits forall a b. (a -> b) -> a -> b
$ PSString
str
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
mightContainInterpolation Text
decoded) forall a b. (a -> b) -> a -> b
$ do
    (FilePath
_, ModuleName
_, SourceSpan
spn) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    ModuleInfo -> Convert ()
tell forall a. Monoid a => a
mempty {interpolatedStrings :: Set SourceSpan
interpolatedStrings = forall a. a -> Set a
S.singleton SourceSpan
spn}
  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]
_) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
> Int
ixOpen) 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) -> Convert Expr
literal (NumericLiteral (Left Integer
n)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Expr
N.int Integer
n
literal (NumericLiteral (Right Double
n)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Double -> Expr
N.double Double
n
literal (StringLiteral PSString
str) = Text -> Expr
N.string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PSString -> Convert Text
string PSString
str
literal (CharLiteral Char
chr) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Expr
N.string forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
chr
literal (BooleanLiteral Bool
b) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Ann -> Convert Expr
expr [Expr Ann]
arr
literal (ObjectLiteral [(PSString, Expr Ann)]
obj) = [(PSString, Expr Ann)] -> Convert Expr
attrs [(PSString, Expr Ann)]
obj