-- |
-- Module      :  Conllu.IO
-- Copyright   :  © 2018 bruno cuconato
-- License     :  LPGL-3
--
-- Maintainer  :  bruno cuconato <bcclaro+hackage@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Defines major IO functions.

module Conllu.IO where

---
-- imports
import Conllu.Type
import Conllu.Utils
import Conllu.Parse
import Conllu.Print
import Conllu.Diff

import System.Directory
import System.FilePath


-- * read functions

---
-- ** readers using a customized parser
-- | these reader functions will read files using a customized
-- parser. you can build one with 'ParserC' and 'parserC'.
readConlluFileWith :: Parser Sent -> FilePath -> IO Doc
-- | reads a file with a customized parser.
readConlluFileWith :: Parser Sent -> FilePath -> IO Doc
readConlluFileWith Parser Sent
p FilePath
f = do
  FilePath
ds <- FilePath -> IO FilePath
readFile FilePath
f
  case Parser Sent -> FilePath -> FilePath -> Either FilePath Doc
parseConlluWith Parser Sent
p FilePath
f FilePath
ds of
    Left FilePath
err -> FilePath -> IO ()
putStr FilePath
err IO () -> IO Doc -> IO Doc
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Right Doc
d -> Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
d

readDirectoryWith :: Parser Sent -> FilePath -> IO [Doc]
-- | reads all the files in a directory as CoNLL-U files with a
-- customized parser.
readDirectoryWith :: Parser Sent -> FilePath -> IO [Doc]
readDirectoryWith Parser Sent
p FilePath
d = do [FilePath]
fs' <- FilePath -> IO [FilePath]
listDirectory FilePath
d
                           let fs :: [FilePath]
fs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
d FilePath -> FilePath -> FilePath
</>) [FilePath]
fs'
                           (FilePath -> IO Doc) -> [FilePath] -> IO [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser Sent -> FilePath -> IO Doc
readConlluFileWith Parser Sent
p) [FilePath]
fs

readConlluWith :: Parser Sent -> FilePath -> IO [Doc]
-- | reads a file or a directory as CoNLL-U files with a customized
-- parser.
readConlluWith :: Parser Sent -> FilePath -> IO [Doc]
readConlluWith Parser Sent
p FilePath
fp = do Bool
f <- FilePath -> IO Bool
doesFileExist FilePath
fp
                         Bool -> IO [Doc] -> IO [Doc] -> IO [Doc]
forall a. Bool -> a -> a -> a
if' Bool
f ((FilePath -> IO Doc) -> [FilePath] -> IO [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Parser Sent -> FilePath -> IO Doc
readConlluFileWith Parser Sent
p) [FilePath
fp]) (IO [Doc] -> IO [Doc]) -> IO [Doc] -> IO [Doc]
forall a b. (a -> b) -> a -> b
$
                           do Bool
d <- FilePath -> IO Bool
doesDirectoryExist FilePath
fp
                              Bool -> IO [Doc] -> IO [Doc] -> IO [Doc]
forall a. Bool -> a -> a -> a
if' Bool
d (Parser Sent -> FilePath -> IO [Doc]
readDirectoryWith Parser Sent
p FilePath
fp) ([Doc] -> IO [Doc]
forall (m :: * -> *) a. Monad m => a -> m a
return [])

---
-- ** readers using default parsers
readConlluFile :: FilePath -> IO Doc
-- | reads a CoNLL-U file.
readConlluFile :: FilePath -> IO Doc
readConlluFile = Parser Sent -> FilePath -> IO Doc
readConlluFileWith Parser Sent
sentence

readDirectory :: FilePath -> IO [Doc]
-- | reads all files in a directory as CoNLL-U files.
readDirectory :: FilePath -> IO [Doc]
readDirectory = Parser Sent -> FilePath -> IO [Doc]
readDirectoryWith Parser Sent
sentence

readConllu :: FilePath -> IO [Doc]
-- | reads a file or a directory as CoNLL-U files.
readConllu :: FilePath -> IO [Doc]
readConllu = Parser Sent -> FilePath -> IO [Doc]
readConlluWith Parser Sent
sentence

---
-- * write
writeConlluFile :: FilePath -> Doc -> IO ()
-- | writes a CoNLL-U file to disk.
writeConlluFile :: FilePath -> Doc -> IO ()
writeConlluFile FilePath
fp = FilePath -> FilePath -> IO ()
writeFile FilePath
fp (FilePath -> IO ()) -> (Doc -> FilePath) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
printDoc

---
-- * print
readAndPrintConllu :: FilePath -> IO ()
-- | reads and prints the CoNLL-U files given.
readAndPrintConllu :: FilePath -> IO ()
readAndPrintConllu FilePath
fp = do
  FilePath -> IO Doc
readConlluFile FilePath
fp IO Doc -> (Doc -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO ()
putStr (FilePath -> IO ()) -> (Doc -> FilePath) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
printDoc
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

---
-- * diff
diffConllu :: FilePath -> FilePath -> IO ()
-- | reads two CoNLL-U files and prints their diffs. this assumes
-- their sentences are paired.
diffConllu :: FilePath -> FilePath -> IO ()
diffConllu FilePath
fp1 FilePath
fp2 = do
  Doc
ss1 <- FilePath -> IO Doc
readConlluFile FilePath
fp1
  Doc
ss2 <- FilePath -> IO Doc
readConlluFile FilePath
fp2
  [[[StringPair]]] -> IO ()
forall a. Show a => a -> IO ()
print ([[[StringPair]]] -> IO ())
-> ([(Sent, Sent)] -> [[[StringPair]]]) -> [(Sent, Sent)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DDiff AW -> [[[StringPair]]]
forall a. DDiff a -> [[[StringPair]]]
printDDiff (DDiff AW -> [[[StringPair]]])
-> ([(Sent, Sent)] -> DDiff AW)
-> [(Sent, Sent)]
-> [[[StringPair]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Sent, Sent)] -> DDiff AW
diffSs ([(Sent, Sent)] -> IO ()) -> [(Sent, Sent)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> [(Sent, Sent)]
forall a b. [a] -> [b] -> [(a, b)]
zip Doc
ss1 Doc
ss2
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()