module Text.Madlibs.Ana.Resolve (
parseFile
, runFile
, makeTree
, runText ) where
import Control.Exception
import Control.Monad (void)
import Control.Monad.Random.Class
import Data.Composition
import Data.Monoid
import qualified Data.Text as T
import Data.Void
import Lens.Micro
import System.Directory
import System.Environment
import Text.Madlibs.Ana.Parse
import Text.Madlibs.Ana.ParseUtils
import Text.Madlibs.Cata.Run
import Text.Madlibs.Internal.Types
import Text.Madlibs.Internal.Utils
import Text.Megaparsec hiding (parseErrorPretty', try)
parseFile :: [T.Text]
-> FilePath
-> FilePath
-> IO (Either (ParseError Char (ErrorFancy Void)) RandTok)
parseFile = fmap (fmap takeTemplate) .** (getInclusionCtx False)
getInclusionCtx :: Bool -> [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)])
getInclusionCtx isTree ins folder filepath = do
file <- catch (readFile' (folder ++ filepath)) (const (do { home <- getEnv "HOME" ; readFile' (home <> "/.madlang/" <> folder <> filepath) } ) :: IOException -> IO T.Text)
let filenames = map T.unpack $ either (error . show) id $ parseInclusions filepath file
let resolveKeys file' = map (over _1 ((((T.pack . (<> "-")) . dropExtension) file') <>))
ctxPure <- mapM (getInclusionCtx isTree ins folder) filenames
let ctx = (zipWith resolveKeys filenames) <$> sequence ctxPure
catch
(parseCtx isTree ins (concat . (either (const []) id) $ ctx) (folder ++ filepath))
((const (do { home <- getEnv "HOME" ; parseCtx isTree ins (concat . (either (const []) id) $ ctx) (home <> "/.madlang/" <> folder <> filepath) }) ) :: IOException -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)]))
runFile :: [T.Text]
-> FilePath
-> IO T.Text
runFile ins toFolder = do
void $ doesDirectoryExist (getDir toFolder)
let filepath = reverse . (takeWhile (/='/')) . reverse $ toFolder
runInFolder ins (getDir toFolder) filepath
runInFolder :: [T.Text] -> FilePath -> FilePath -> IO T.Text
runInFolder = ((either (pure . parseErrorPretty') (>>= (pure . show'))) =<<) .** (fmap (fmap run) .** parseFile)
runText :: (MonadRandom m) => [T.Text] -> String -> T.Text -> m T.Text
runText vars name = (either (pure . parseErrorPretty') id) . (fmap run) . (parseTok name [] vars)
parseCtx :: Bool -> [T.Text] -> [(Key, RandTok)] -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) [(Key, RandTok)])
parseCtx isTree ins state filepath = do
txt <- readFile' filepath
let keys = (if isTree then parseTreeF else parseTokF) filepath state ins txt
pure keys
makeTree :: [T.Text] -> FilePath -> FilePath -> IO (Either (ParseError Char (ErrorFancy Void)) RandTok)
makeTree = fmap (fmap takeTemplate) .** (getInclusionCtx True)