{-# LANGUAGE NoImplicitPrelude #-}

module PureNix.Main where

import qualified Data.Aeson as Aeson
import Data.Aeson.Types (parseEither)
import Data.Foldable (toList)
import Data.List (intercalate)
import qualified Data.Text.Lazy.IO as TL
import qualified Language.PureScript.CoreFn as P
import Language.PureScript.CoreFn.FromJSON (moduleFromJSON)
import PureNix.Convert (ModuleInfo (ModuleInfo), convert)
import PureNix.Prelude
import PureNix.Print (renderExpr)
import qualified System.Directory as Dir
import qualified System.Exit as Sys
import System.FilePath ((</>))
import qualified System.FilePath as FP
import System.IO

defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = do
  let workdir :: [Char]
workdir = [Char]
"."
  let moduleRoot :: [Char]
moduleRoot = [Char]
workdir [Char] -> [Char] -> [Char]
</> [Char]
"output"
  [[Char]]
moduleDirs <- ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"cache-db.json") ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
Dir.listDirectory [Char]
moduleRoot
  [[Char]] -> ([Char] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
moduleDirs (([Char] -> IO ()) -> IO ()) -> ([Char] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Char]
rel -> do
    let dir :: [Char]
dir = [Char]
moduleRoot [Char] -> [Char] -> [Char]
</> [Char]
rel
    let file :: [Char]
file = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"corefn.json"
    Value
value <- [Char] -> IO (Either [Char] Value)
forall a. FromJSON a => [Char] -> IO (Either [Char] a)
Aeson.eitherDecodeFileStrict [Char]
file IO (Either [Char] Value)
-> (Either [Char] Value -> IO Value) -> IO Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO Value)
-> (Value -> IO Value) -> Either [Char] Value -> IO Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO Value
forall a. [Char] -> IO a
Sys.die Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Version
_version, Module Ann
module') <- ([Char] -> IO (Version, Module Ann))
-> ((Version, Module Ann) -> IO (Version, Module Ann))
-> Either [Char] (Version, Module Ann)
-> IO (Version, Module Ann)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO (Version, Module Ann)
forall a. [Char] -> IO a
Sys.die (Version, Module Ann) -> IO (Version, Module Ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] (Version, Module Ann) -> IO (Version, Module Ann))
-> Either [Char] (Version, Module Ann) -> IO (Version, Module Ann)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser (Version, Module Ann))
-> Value -> Either [Char] (Version, Module Ann)
forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither Value -> Parser (Version, Module Ann)
moduleFromJSON Value
value
    let (Expr
nix, ModuleInfo Bool
usesFFI Set SourceSpan
interpolations) = Module Ann -> (Expr, ModuleInfo)
convert Module Ann
module'
    [Char] -> Text -> IO ()
TL.writeFile ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"default.nix") (Expr -> Text
renderExpr Expr
nix)
    let modulePath :: [Char]
modulePath = Module Ann -> [Char]
forall a. Module a -> [Char]
P.modulePath Module Ann
module'
        foreignSrc :: [Char]
foreignSrc = [Char]
workdir [Char] -> [Char] -> [Char]
</> [Char] -> [Char] -> [Char]
FP.replaceExtension [Char]
modulePath [Char]
"nix"
        foreignTrg :: [Char]
foreignTrg = [Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
"foreign.nix"
    Bool
hasForeign <- [Char] -> IO Bool
Dir.doesFileExist [Char]
foreignSrc
    case (Bool
hasForeign, Bool
usesFFI) of
      (Bool
True, Bool
True) -> [Char] -> [Char] -> IO ()
Dir.copyFile [Char]
foreignSrc [Char]
foreignTrg
      (Bool
True, Bool
False) -> Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
modulePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" has an FFI file, but does not use FFI!"
      (Bool
False, Bool
True) -> Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
modulePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" calls foreign functions, but has no associated FFI file!"
      (Bool
False, Bool
False) -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set SourceSpan -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set SourceSpan
interpolations) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
        [[Char]] -> [Char]
unlines
          [ [Char]
"Warning: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
modulePath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" appears to perform Nix string interpolation in the following locations:",
            [Char]
"  " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (SourceSpan -> [Char]
forall a. Show a => a -> [Char]
show (SourceSpan -> [Char]) -> [SourceSpan] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set SourceSpan -> [SourceSpan]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set SourceSpan
interpolations),
            [Char]
"Nix string interpolations are currently not officially supported and may cause unexpected behavior."
          ]