-- | All functions that take a 'Handle' or 'FilePath' do their reading/writing
-- strictly.
{-# LANGUAGE CPP #-}
module Data.DTA
( DTA(..), Tree(..), Chunk(..)
, lFromDTB, hFromDTB, hFromDTBv2, fromDTB
, lToDTB, hToDTB, toDTB
, sFromDTA, hFromDTA, fromDTA
, sToDTA, hToDTA, toDTA
, renumberFrom
) where

#if __GLASGOW_HASKELL__ < 710
import           Control.Applicative   ((<$>))
#endif
import           System.IO             (Handle, IOMode (ReadMode, WriteMode),
                                        withFile)

import           Data.Binary           (decode, encode)
import           Data.Binary.Get       (runGet)
import qualified Data.ByteString       as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy  as BL

import           Data.DTA.Base
import           Data.DTA.Lex
import           Data.DTA.Parse
import           Data.DTA.PrettyPrint

lFromDTB :: BL.ByteString -> DTA
lFromDTB :: ByteString -> DTA
lFromDTB = ByteString -> DTA
forall a. Binary a => ByteString -> a
decode

lToDTB :: DTA -> BL.ByteString
lToDTB :: DTA -> ByteString
lToDTB = DTA -> ByteString
forall a. Binary a => a -> ByteString
encode

fromDTB :: FilePath -> IO DTA
fromDTB :: FilePath -> IO DTA
fromDTB FilePath
fp = FilePath -> IOMode -> (Handle -> IO DTA) -> IO DTA
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode Handle -> IO DTA
hFromDTB

hFromDTB :: Handle -> IO DTA
hFromDTB :: Handle -> IO DTA
hFromDTB Handle
h = ByteString -> DTA
forall a. Binary a => ByteString -> a
decode (ByteString -> DTA)
-> (ByteString -> ByteString) -> ByteString -> DTA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
strictToLazy (ByteString -> DTA) -> IO ByteString -> IO DTA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
B.hGetContents Handle
h
  where strictToLazy :: ByteString -> ByteString
strictToLazy ByteString
b = [ByteString] -> ByteString
BL.fromChunks [ByteString
b]

hFromDTBv2 :: Handle -> IO DTA
hFromDTBv2 :: Handle -> IO DTA
hFromDTBv2 Handle
h = Get DTA -> ByteString -> DTA
forall a. Get a -> ByteString -> a
runGet (DTAVersion -> Get DTA
binaryDTA DTAVersion
DTAVersion2) (ByteString -> DTA)
-> (ByteString -> ByteString) -> ByteString -> DTA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
strictToLazy (ByteString -> DTA) -> IO ByteString -> IO DTA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
B.hGetContents Handle
h
  where strictToLazy :: ByteString -> ByteString
strictToLazy ByteString
b = [ByteString] -> ByteString
BL.fromChunks [ByteString
b]

toDTB :: FilePath -> DTA -> IO ()
toDTB :: FilePath -> DTA -> IO ()
toDTB FilePath
fp DTA
dta = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> DTA -> IO ()
hToDTB Handle
h DTA
dta

hToDTB :: Handle -> DTA -> IO ()
hToDTB :: Handle -> DTA -> IO ()
hToDTB Handle
h DTA
dta = Handle -> ByteString -> IO ()
B.hPutStr Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
lazyToStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DTA -> ByteString
forall a. Binary a => a -> ByteString
encode DTA
dta
  where lazyToStrict :: ByteString -> ByteString
lazyToStrict = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks

sFromDTA :: String -> DTA
sFromDTA :: FilePath -> DTA
sFromDTA = [(AlexPosn, Token)] -> DTA
parse ([(AlexPosn, Token)] -> DTA)
-> (FilePath -> [(AlexPosn, Token)]) -> FilePath -> DTA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [(AlexPosn, Token)]
scan

bFromDTA :: B8.ByteString -> DTA
bFromDTA :: ByteString -> DTA
bFromDTA = FilePath -> DTA
sFromDTA (FilePath -> DTA) -> (ByteString -> FilePath) -> ByteString -> DTA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
B8.unpack

hFromDTA :: Handle -> IO DTA
hFromDTA :: Handle -> IO DTA
hFromDTA Handle
h = ByteString -> DTA
bFromDTA (ByteString -> DTA) -> IO ByteString -> IO DTA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO ByteString
B8.hGetContents Handle
h

fromDTA :: FilePath -> IO DTA
fromDTA :: FilePath -> IO DTA
fromDTA FilePath
fp = FilePath -> IOMode -> (Handle -> IO DTA) -> IO DTA
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode Handle -> IO DTA
hFromDTA

bToDTA :: DTA -> B8.ByteString
bToDTA :: DTA -> ByteString
bToDTA = FilePath -> ByteString
B8.pack (FilePath -> ByteString) -> (DTA -> FilePath) -> DTA -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTA -> FilePath
sToDTA

hToDTA :: Handle -> DTA -> IO ()
hToDTA :: Handle -> DTA -> IO ()
hToDTA Handle
h = Handle -> ByteString -> IO ()
B8.hPutStr Handle
h (ByteString -> IO ()) -> (DTA -> ByteString) -> DTA -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTA -> ByteString
bToDTA

toDTA :: FilePath -> DTA -> IO ()
toDTA :: FilePath -> DTA -> IO ()
toDTA FilePath
fp DTA
dta = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> DTA -> IO ()
hToDTA Handle
h DTA
dta