{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Internal utils to help out elsewhere
module Text.Madlibs.Internal.Utils where

import           Control.Arrow               (first)
import           Control.Exception           (IOException, catch, throw)
import qualified Data.Text                   as T
import           Data.Void
import           System.FilePath             (pathSeparator)
import           Text.Madlibs.Cata.SemErr
import           Text.Madlibs.Internal.Types
import           Text.Megaparsec.Error

-- | Get directory associated to a file
getDir :: FilePath -> FilePath
getDir = reverse . dropWhile (/= pathSeparator) . reverse

-- | Normalize pre-tokens/corresponding probabilities
normalize :: (Fractional a) => [(a, [PreTok])] -> [(a, [PreTok])]
normalize list = fmap (first (/total)) list
    where total = sum . fmap fst $ list
    -- TODO: use a half-decent numerical method

-- | Helper function for creating a cdf from a pdf
cdf :: Num a => [a] -> [a]
cdf = drop 2 . scanl (+) 0 . (:) 0

-- | Show as a T.Text
show' :: (Show a) => a -> T.Text
show' = T.drop 1 . T.init . T.pack . show

-- | Pretty-print a ParseError
errorBundlePretty' :: ParseErrorBundle T.Text Void -> T.Text
errorBundlePretty' = T.pack . errorBundlePretty

-- | Strip a pre-token's name
unTok :: PreTok -> T.Text
unTok PreTok{}     = ""
unTok (Name txt _) = txt

readLibFile :: FilePath -> IO T.Text
readLibFile path = catch (fmap T.pack . readFile $ path) (throw (ImportNotFound path) :: IOException -> IO T.Text)

-- | Read a file in as a `Text`
readFile' :: FilePath -> IO T.Text
readFile' = fmap T.pack . readFile