module Text.StringTemplates.Files (getTemplates) where
import Data.Char (isAlphaNum,isControl,isSpace)
import Data.List (intercalate, isPrefixOf)
import Data.Maybe (maybeToList)
import System.IO
getTemplates :: FilePath
-> IO [(String, String)]
getTemplates :: FilePath -> IO [(FilePath, FilePath)]
getTemplates FilePath
fp =
FilePath
-> IOMode
-> (Handle -> IO [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)]
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode ((Handle -> IO [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)])
-> (Handle -> IO [(FilePath, FilePath)])
-> IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8
Handle -> IO [(FilePath, FilePath)]
parseTemplates Handle
handle
parseTemplates :: Handle -> IO [(String,String)]
parseTemplates :: Handle -> IO [(FilePath, FilePath)]
parseTemplates Handle
handle = do
Bool
e <- Handle -> IO Bool
hIsEOF Handle
handle
if (Bool
e)
then [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
Maybe (FilePath, FilePath)
t <- Handle -> IO (Maybe (FilePath, FilePath))
parseTemplate Handle
handle
[(FilePath, FilePath)]
ts <- Handle -> IO [(FilePath, FilePath)]
parseTemplates Handle
handle
[(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, FilePath)] -> IO [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> IO [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ (Maybe (FilePath, FilePath) -> [(FilePath, FilePath)]
forall a. Maybe a -> [a]
maybeToList Maybe (FilePath, FilePath)
t) [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
ts
parseTemplate :: Handle -> IO (Maybe (String, String))
parseTemplate :: Handle -> IO (Maybe (FilePath, FilePath))
parseTemplate Handle
handle = do
[FilePath]
ls <- Handle -> IO [FilePath]
parseLines Handle
handle
let (FilePath
name,FilePath
t) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
head [FilePath]
ls
if ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ls Bool -> Bool -> Bool
|| FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath
name) Bool -> Bool -> Bool
|| FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
t)
then Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing
else do
let template :: FilePath
template = if (FilePath
"=*" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
t)
then (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Bool -> Bool
not (Char -> Bool
isControl Char
c) Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
2 FilePath
t)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ([FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
tail [FilePath]
ls))
else FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\r\n" ((FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
tail FilePath
t)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: ([FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
tail [FilePath]
ls))
Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath)))
-> Maybe (FilePath, FilePath) -> IO (Maybe (FilePath, FilePath))
forall a b. (a -> b) -> a -> b
$ (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum FilePath
name,FilePath
template)
parseLines :: Handle -> IO [String]
parseLines :: Handle -> IO [FilePath]
parseLines Handle
handle = do
FilePath
l <- Handle -> IO FilePath
hGetLine Handle
handle
Bool
e <- Handle -> IO Bool
hIsEOF Handle
handle
if (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (FilePath
"#") FilePath
l)
then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else if Bool
e
then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
l]
else ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((:) FilePath
l) (Handle -> IO [FilePath]
parseLines Handle
handle)