module Library where

import qualified CodeGeneration.FSharp as FSharp
import qualified CodeGeneration.Python as Python
import qualified CodeGeneration.TypeScript as TypeScript
import qualified Data.Text.IO as TextIO
import qualified Parsing
import RIO
import qualified RIO.Directory as Directory
import qualified RIO.FilePath as FilePath
import qualified RIO.List as List
import qualified RIO.Time as Time
import qualified System.FSNotify as FSNotify
import Types
import Prelude (print, putStrLn)

data OutputDestination
  = SameAsInput
  | OutputPath !FilePath
  | StandardOut
  deriving (OutputDestination -> OutputDestination -> Bool
(OutputDestination -> OutputDestination -> Bool)
-> (OutputDestination -> OutputDestination -> Bool)
-> Eq OutputDestination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputDestination -> OutputDestination -> Bool
$c/= :: OutputDestination -> OutputDestination -> Bool
== :: OutputDestination -> OutputDestination -> Bool
$c== :: OutputDestination -> OutputDestination -> Bool
Eq, Int -> OutputDestination -> ShowS
[OutputDestination] -> ShowS
OutputDestination -> String
(Int -> OutputDestination -> ShowS)
-> (OutputDestination -> String)
-> ([OutputDestination] -> ShowS)
-> Show OutputDestination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputDestination] -> ShowS
$cshowList :: [OutputDestination] -> ShowS
show :: OutputDestination -> String
$cshow :: OutputDestination -> String
showsPrec :: Int -> OutputDestination -> ShowS
$cshowsPrec :: Int -> OutputDestination -> ShowS
Show)

data Languages = Languages
  { Languages -> Maybe OutputDestination
typescript :: !(Maybe OutputDestination),
    Languages -> Maybe OutputDestination
fsharp :: !(Maybe OutputDestination),
    Languages -> Maybe OutputDestination
python :: !(Maybe OutputDestination)
  }
  deriving (Languages -> Languages -> Bool
(Languages -> Languages -> Bool)
-> (Languages -> Languages -> Bool) -> Eq Languages
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Languages -> Languages -> Bool
$c/= :: Languages -> Languages -> Bool
== :: Languages -> Languages -> Bool
$c== :: Languages -> Languages -> Bool
Eq, Int -> Languages -> ShowS
[Languages] -> ShowS
Languages -> String
(Int -> Languages -> ShowS)
-> (Languages -> String)
-> ([Languages] -> ShowS)
-> Show Languages
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Languages] -> ShowS
$cshowList :: [Languages] -> ShowS
show :: Languages -> String
$cshow :: Languages -> String
showsPrec :: Int -> Languages -> ShowS
$cshowsPrec :: Int -> Languages -> ShowS
Show)

data Options = Options
  { Options -> Languages
languages :: !Languages,
    Options -> Bool
watchMode :: !Bool,
    Options -> Bool
verbose :: !Bool,
    Options -> [String]
inputs :: ![FilePath]
  }
  deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

runMain :: Options -> IO ()
runMain :: Options -> IO ()
runMain
  Options
    { $sel:languages:Options :: Options -> Languages
languages = languages :: Languages
languages@Languages {Maybe OutputDestination
typescript :: Maybe OutputDestination
$sel:typescript:Languages :: Languages -> Maybe OutputDestination
typescript, Maybe OutputDestination
fsharp :: Maybe OutputDestination
$sel:fsharp:Languages :: Languages -> Maybe OutputDestination
fsharp, Maybe OutputDestination
python :: Maybe OutputDestination
$sel:python:Languages :: Languages -> Maybe OutputDestination
python},
      [String]
inputs :: [String]
$sel:inputs:Options :: Options -> [String]
inputs,
      Bool
watchMode :: Bool
$sel:watchMode:Options :: Options -> Bool
watchMode,
      Bool
verbose :: Bool
$sel:verbose:Options :: Options -> Bool
verbose
    } = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
watchMode (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      [String] -> Languages -> Bool -> IO ()
watchInputs [String]
inputs Languages
languages Bool
verbose
    UTCTime
start <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
    Either [String] [Module]
maybeModules <- [String] -> IO (Either [String] [Module])
Parsing.parseModules [String]
inputs
    UTCTime
postParsing <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
    case Either [String] [Module]
maybeModules of
      Right [Module]
modules -> do
        UTCTime
startTS <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
typescript ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
TypeScript.outputModule String
"ts"
        UTCTime
endTS <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        UTCTime
startFS <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
fsharp ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
FSharp.outputModule String
"fs"
        UTCTime
endFS <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        UTCTime
startPython <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
python ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
Python.outputModule String
"py"
        UTCTime
endPython <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        UTCTime
end <- IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
Time.getCurrentTime
        let diff :: NominalDiffTime
diff = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
end UTCTime
start
            diffParsing :: NominalDiffTime
diffParsing = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
postParsing UTCTime
start
            diffTS :: NominalDiffTime
diffTS = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
endTS UTCTime
startTS
            diffFS :: NominalDiffTime
diffFS = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
endFS UTCTime
startFS
            diffPython :: NominalDiffTime
diffPython = UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
endPython UTCTime
startPython
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Parsing took: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
diffParsing
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Outputting TypeScript took: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
diffTS
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Outputting FSharp took: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
diffFS
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Outputting Python took: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
diffPython
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Entire compilation took: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
diff
      Left [String]
errors -> [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
errors String -> IO ()
putStrLn

outputLanguage :: [Module] -> (Module -> Text) -> FilePath -> OutputDestination -> IO ()
outputLanguage :: [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
outputFunction String
extension OutputDestination
outputDestination = do
  let outputs :: [(Module, Text)]
outputs = [Module]
modules [Module] -> ([Module] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Module -> Text) -> [Module] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Module -> Text
outputFunction [Text] -> ([Text] -> [(Module, Text)]) -> [(Module, Text)]
forall a b. a -> (a -> b) -> b
& [Module] -> [Text] -> [(Module, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Module]
modules
  case OutputDestination
outputDestination of
    OutputDestination
StandardOut -> do
      [(Module, Text)]
outputs [(Module, Text)]
-> ([(Module, Text)] -> [(Module, Text)]) -> [(Module, Text)]
forall a b. a -> (a -> b) -> b
& [(Module, Text)] -> [(Module, Text)]
forall a. [a] -> [a]
reverse [(Module, Text)]
-> ([(Module, Text)] -> ((Module, Text) -> IO ()) -> IO ())
-> ((Module, Text) -> IO ())
-> IO ()
forall a b. a -> (a -> b) -> b
& [(Module, Text)] -> ((Module, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((Module, Text) -> IO ()) -> IO ())
-> ((Module, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Module
_module, Text
output) -> Text -> IO ()
TextIO.putStrLn Text
output
    OutputDestination
SameAsInput -> do
      [(Module, Text)] -> ((Module, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Module, Text)]
outputs (((Module, Text) -> IO ()) -> IO ())
-> ((Module, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Module {String
$sel:sourceFile:Module :: Module -> String
sourceFile :: String
sourceFile}, Text
output) -> do
        let pathForOutput :: String
pathForOutput = String -> ShowS
FilePath.replaceExtensions String
sourceFile String
extension
        String -> Text -> IO ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileUtf8 String
pathForOutput Text
output
    OutputPath String
outputDirectory -> do
      [(Module, Text)] -> ((Module, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Module, Text)]
outputs (((Module, Text) -> IO ()) -> IO ())
-> ((Module, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Module {String
sourceFile :: String
$sel:sourceFile:Module :: Module -> String
sourceFile}, Text
output) -> do
        let pathForOutput :: String
pathForOutput =
              String -> ShowS
FilePath.replaceDirectory String
sourceFile String
outputDirectory
                String -> ShowS -> String
forall a b. a -> (a -> b) -> b
& (String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> ShowS
FilePath.replaceExtensions String
extension
            basePath :: String
basePath = ShowS
FilePath.takeDirectory String
pathForOutput
        Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
Directory.createDirectoryIfMissing Bool
True String
basePath
        String -> Text -> IO ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
writeFileUtf8 String
pathForOutput Text
output

watchInputs :: [FilePath] -> Languages -> Bool -> IO ()
watchInputs :: [String] -> Languages -> Bool -> IO ()
watchInputs [String]
relativeInputs Languages {Maybe OutputDestination
typescript :: Maybe OutputDestination
$sel:typescript:Languages :: Languages -> Maybe OutputDestination
typescript, Maybe OutputDestination
fsharp :: Maybe OutputDestination
$sel:fsharp:Languages :: Languages -> Maybe OutputDestination
fsharp, Maybe OutputDestination
python :: Maybe OutputDestination
$sel:python:Languages :: Languages -> Maybe OutputDestination
python} Bool
verbose = do
  [String]
inputs <- (String -> IO String) -> [String] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO String
forall (m :: * -> *). MonadIO m => String -> m String
Directory.makeAbsolute [String]
relativeInputs
  let compileEverything :: IO ()
compileEverything = do
        Either [String] [Module]
maybeModules <- [String] -> IO (Either [String] [Module])
Parsing.parseModules [String]
relativeInputs
        case Either [String] [Module]
maybeModules of
          Right [Module]
modules -> do
            Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
typescript ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
TypeScript.outputModule String
"ts"
            Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
fsharp ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
FSharp.outputModule String
"fs"
            Maybe OutputDestination -> (OutputDestination -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe OutputDestination
python ((OutputDestination -> IO ()) -> IO ())
-> (OutputDestination -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ [Module]
-> (Module -> Text) -> String -> OutputDestination -> IO ()
outputLanguage [Module]
modules Module -> Text
Python.outputModule String
"py"
          Left [String]
errors ->
            [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
errors String -> IO ()
putStrLn
      debounceInterval :: NominalDiffTime
debounceInterval = NominalDiffTime
0.01 :: Time.NominalDiffTime
      fsNotifyConfig :: WatchConfig
fsNotifyConfig = WatchConfig
FSNotify.defaultConfig {confDebounce :: Debounce
FSNotify.confDebounce = NominalDiffTime -> Debounce
FSNotify.Debounce NominalDiffTime
debounceInterval}
  IO ()
compileEverything
  WatchConfig -> (WatchManager -> IO ()) -> IO ()
forall a. WatchConfig -> (WatchManager -> IO a) -> IO a
FSNotify.withManagerConf WatchConfig
fsNotifyConfig ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
watchManager -> do
    let inputDirectories :: [String]
inputDirectories = [String]
inputs [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
FilePath.takeDirectory [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& [String] -> [String]
forall a. Eq a => [a] -> [a]
List.nub
        eventPredicate :: Event -> Bool
eventPredicate (FSNotify.Modified String
modifiedInput UTCTime
_modificationTime Bool
_someBool) =
          String
modifiedInput String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inputs
        eventPredicate Event
_otherEvents = Bool
False
    [String] -> (String -> IO (IO ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
inputDirectories ((String -> IO (IO ())) -> IO ())
-> (String -> IO (IO ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
inputDirectory -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Watching directory: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
inputDirectory String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
      WatchManager -> String -> (Event -> Bool) -> Action -> IO (IO ())
FSNotify.watchDir
        WatchManager
watchManager
        String
inputDirectory
        Event -> Bool
eventPredicate
        ( \Event
event -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (Action
forall a. Show a => a -> IO ()
print Event
event)
            IO ()
compileEverything
        )
    IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay Int
1000000