{-# LANGUAGE ExistentialQuantification, OverloadedStrings, RankNTypes #-}
-- | Applying the user expression as directed by the HawkRuntime.
--   The API may change at any time.
module System.Console.Hawk.Runtime
  ( SomeRows(..)
  , processTable
  ) where

import Control.Exception
import Data.ByteString.Lazy.Char8 as B
import Data.ByteString.Lazy.Search as Search
import GHC.IO.Exception
import System.IO

import System.Console.Hawk.Args.Spec
import System.Console.Hawk.Representable
import System.Console.Hawk.Runtime.Base


data SomeRows = forall a. Rows a => SomeRows a

processTable :: HawkRuntime -> ([[B.ByteString]] -> SomeRows) -> HawkIO ()
processTable :: HawkRuntime -> ([[ByteString]] -> SomeRows) -> HawkIO ()
processTable HawkRuntime
runtime [[ByteString]] -> SomeRows
f = IO () -> HawkIO ()
forall a. IO a -> HawkIO a
HawkIO (IO () -> HawkIO ()) -> IO () -> HawkIO ()
forall a b. (a -> b) -> a -> b
$ do
    [[ByteString]]
xss <- InputSpec -> IO [[ByteString]]
getTable (HawkRuntime -> InputSpec
inputSpec HawkRuntime
runtime)
    case [[ByteString]] -> SomeRows
f [[ByteString]]
xss of
      SomeRows a
x -> OutputSpec -> a -> IO ()
forall a. Rows a => OutputSpec -> a -> IO ()
outputRows (HawkRuntime -> OutputSpec
outputSpec HawkRuntime
runtime) a
x


getTable :: InputSpec -> IO [[B.ByteString]]
getTable :: InputSpec -> IO [[ByteString]]
getTable InputSpec
spec = ByteString -> [[ByteString]]
splitIntoTable' (ByteString -> [[ByteString]])
-> IO ByteString -> IO [[ByteString]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
getInputString'
  where
    splitIntoTable' :: ByteString -> [[ByteString]]
splitIntoTable' = InputFormat -> ByteString -> [[ByteString]]
splitIntoTable (InputSpec -> InputFormat
inputFormat InputSpec
spec)
    getInputString' :: IO ByteString
getInputString' = InputSource -> IO ByteString
getInputString (InputSpec -> InputSource
inputSource InputSpec
spec)

getInputString :: InputSource -> IO B.ByteString
getInputString :: InputSource -> IO ByteString
getInputString InputSource
NoInput = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
getInputString InputSource
UseStdin = IO ByteString
B.getContents
getInputString (InputFile FilePath
f) = FilePath -> IO ByteString
B.readFile FilePath
f

-- [[contents]]
-- or
-- [[record0], [record1], ...]
-- or
-- [[field0, field1, ...], [field0, field1, ...], ...]
splitIntoTable :: InputFormat -> B.ByteString -> [[B.ByteString]]
splitIntoTable :: InputFormat -> ByteString -> [[ByteString]]
splitIntoTable InputFormat
RawStream = [ByteString] -> [[ByteString]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return
splitIntoTable (Records Separator
sep RecordFormat
format) = (ByteString -> [ByteString]) -> [ByteString] -> [[ByteString]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> [ByteString]
splitIntoFields' ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitIntoRecords'
  where
    splitIntoFields' :: ByteString -> [ByteString]
splitIntoFields' = RecordFormat -> ByteString -> [ByteString]
splitIntoFields RecordFormat
format
    splitIntoRecords' :: ByteString -> [ByteString]
splitIntoRecords' = Separator -> ByteString -> [ByteString]
splitAtSeparator Separator
sep

-- [record]
-- or
-- [field0, field1, ...]
splitIntoFields :: RecordFormat -> B.ByteString -> [B.ByteString]
splitIntoFields :: RecordFormat -> ByteString -> [ByteString]
splitIntoFields RecordFormat
RawRecord = ByteString -> [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return
splitIntoFields (Fields Separator
sep) = Separator -> ByteString -> [ByteString]
splitAtSeparator Separator
sep

splitAtSeparator :: Separator -> B.ByteString -> [B.ByteString]
splitAtSeparator :: Separator -> ByteString -> [ByteString]
splitAtSeparator Separator
Whitespace = ByteString -> [ByteString]
B.words
splitAtSeparator (Delimiter Delimiter
"\n") = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
dropWindowsNewline ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
  where
    dropWindowsNewline :: B.ByteString -> B.ByteString
    dropWindowsNewline :: ByteString -> ByteString
dropWindowsNewline ByteString
"" = ByteString
""
    dropWindowsNewline ByteString
s
        | Char
last_char Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = ByteString
s'
        | Bool
otherwise = ByteString
s
      where
        last_char :: Char
last_char = ByteString -> Char
B.last ByteString
s
        n :: Int64
n = ByteString -> Int64
B.length ByteString
s
        s' :: ByteString
s' = Int64 -> ByteString -> ByteString
B.take (Int64
n Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
s
splitAtSeparator (Delimiter Delimiter
d) = Delimiter -> ByteString -> [ByteString]
Search.split Delimiter
d


outputRows :: Rows a => OutputSpec -> a -> IO ()
outputRows :: OutputSpec -> a -> IO ()
outputRows (OutputSpec OutputSink
_ OutputFormat
spec) a
x = IO () -> IO ()
ignoringBrokenPipe (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let s :: ByteString
s = [ByteString] -> ByteString
join' (a -> [ByteString]
toRows a
x)
    ByteString -> IO ()
B.putStr ByteString
s
    Handle -> IO ()
hFlush Handle
stdout
  where
    join' :: [ByteString] -> ByteString
join' = ByteString -> [ByteString] -> ByteString
join (Delimiter -> ByteString
B.fromStrict (Delimiter -> ByteString) -> Delimiter -> ByteString
forall a b. (a -> b) -> a -> b
$ OutputFormat -> Delimiter
recordDelimiter OutputFormat
spec)
    toRows :: a -> [ByteString]
toRows = ByteString -> a -> [ByteString]
forall a. Rows a => ByteString -> a -> [ByteString]
repr (Delimiter -> ByteString
B.fromStrict (Delimiter -> ByteString) -> Delimiter -> ByteString
forall a b. (a -> b) -> a -> b
$ OutputFormat -> Delimiter
fieldDelimiter OutputFormat
spec)

    join :: B.ByteString -> [B.ByteString] -> B.ByteString
    join :: ByteString -> [ByteString] -> ByteString
join ByteString
"\n" = [ByteString] -> ByteString
B.unlines
    join ByteString
sep  = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
sep

-- Don't fret if stdout is closed early, that is the way of shell pipelines.
ignoringBrokenPipe :: IO () -> IO ()
ignoringBrokenPipe :: IO () -> IO ()
ignoringBrokenPipe = (IOException -> Maybe IOException)
-> (IOException -> IO ()) -> IO () -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust IOException -> Maybe IOException
isBrokenPipe ((IOException -> IO ()) -> IO () -> IO ())
-> (IOException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
_ ->
    -- ignore the broken pipe
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    isBrokenPipe :: IOException -> Maybe IOException
isBrokenPipe IOException
e | IOException -> IOErrorType
ioe_type IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished = IOException -> Maybe IOException
forall a. a -> Maybe a
Just IOException
e
    isBrokenPipe IOException
_                                  = Maybe IOException
forall a. Maybe a
Nothing