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