Main.hs

{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE ImportQualifiedPost        #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}

-- | This example implements a generator for randomized fake data, which
-- takes its instructions in the form of a PureScript program.
-- 
-- It takes a filename as its first command line argument, and a random
-- seed as an integer-valued second argument. The input file should contain
-- PureScript source for a module which defines a @main@
-- value for the expression which builds randomized outputs.
--
-- It can be run on the command line as follows:
-- 
-- @
--   cat > build.purs
--   module Main where
--   import Choose (choose)
--   main = { foo: choose [1, 2, 3] }
--   ^D
--
--   fake-data build.purs 12345
-- @

module Main where

import Control.Monad.IO.Class (MonadIO(..))
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty qualified as Pretty
import Data.ByteString.Lazy.Char8 qualified as BL8
import Data.Foldable (traverse_)
import Data.IORef (IORef, atomicModifyIORef', newIORef)
import Data.Text.IO qualified as Text
import Data.Tuple (swap)
import Data.Vector ((!))
import Dovetail
import Dovetail.Aeson qualified as JSON
import Dovetail.FFI.Builder qualified as FFI
import Dovetail.Prelude (stdlib)
import Language.PureScript qualified as P
import Language.PureScript.CoreFn qualified as CoreFn
import System.Environment (getArgs)
import System.Exit (die)
import System.Random qualified as Random

type Context = IORef Random.StdGen

main :: IO ()
main = do
  -- Read the module filename from the CLI arguments, and read the module source
  [moduleFile, seedString] <- getArgs
  moduleText <- Text.readFile moduleFile
  
  let seed = read seedString :: Int
  
  -- This helper function assists in writing the following code in a more 
  -- direct style:
  let orDie e f = e >>= either (liftIO . die . f) pure
  
  -- Create a deterministic random generator from the seed input
  gen <- newIORef (Random.mkStdGen seed)
  
  -- The interpretation of our PureScript module is a JSON value, whose
  -- computation may involve side-effects in the 'M' monad.
  let buildResult 
        :: IO (Either (InterpretError ()) Aeson.Value)
      buildResult = runInterpret () do
        traverse_ ffi stdlib
        
        -- Include the JSON library, in case the user wants to return
        -- nulls using 'JSON.Nullable'.
        _ <- JSON.stdlib
        
        -- This example defines a single interesting function on the
        -- Haskell side: the @choose@ function demonstrates the idea of using
        -- side-effects in the interpreter - @choose@ chooses randomly between one of
        -- its inputs, and returns the selected value
        --
        -- For random number generation, we use a state monad whose state tracks a
        -- standard deterministic generator.
        ffi $ FFI.evalFFIBuilder (P.ModuleName "Choose") do
          FFI.foreignImport (P.Ident "choose")
            (\a -> array a ~> a)
            \xs -> do
              idx <- liftIO (atomicModifyIORef' gen (swap . Random.randomR (0, length xs - 1)))
              pure (xs ! idx)
              
        CoreFn.Module{ CoreFn.moduleName } <- build moduleText
        
        -- Evaluate "main", returning JSON
        JSON.evalJSON (Just moduleName) "main"

  -- Interpret the main function of the PureScript module as a non-deterministic
  -- JSON result
  output <- buildResult `orDie` renderInterpretError defaultTerminalRenderValueOptions

  -- Render the output as pretty-printed JSON on standard output.
  BL8.putStrLn (Pretty.encodePretty output)