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