{-# LANGUAGE OverloadedStrings, DeriveGeneric, NoMonomorphismRestriction, RankNTypes, BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Exception (catch)
import Control.Monad (forever)
import Data.Bool (bool)
import qualified Data.Text as Text
import qualified Data.Text.Read as Text
import qualified Data.Text.IO as Text
import qualified Data.Char as Char
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson (Parser)
--import qualified Data.ByteString.Streaming.Aeson as Aeson (streamParse)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as ByteString.Lazy
--import Data.JsonStream.Parser (value, arrayOf, (.:), Parser)
--import Data.Aeson (FromJSON, parseJSON, withObject)
import qualified Data.Aeson.TH as TH (deriveJSON, defaultOptions, defaultTaggedObject, Options(fieldLabelModifier,constructorTagModifier,sumEncoding),tagFieldName)
import Data.Text (Text)
import Data.Function ((&))
--import Streaming
--import qualified Streaming.Prelude as S
import           System.IO.Streams (Generator, InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import Control.Applicative
import qualified Data.Aeson as Aeson
import Data.ByteString
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import System.IO (stdin, stderr)
import qualified System.IO as String (hPutStrLn)
import System.IO (hFlush)
import GHC.IO.Handle.FD (fdToHandle)
import System.IO.Streams hiding (stdin, stderr)
import System.IO.Streams.Attoparsec (parseFromStream)
import System.IO.Streams.Attoparsec (ParseException)
import Options.Applicative

data Options = Options
    { optionsSignalInputURI :: Maybe Text
    , optionsControlOutputURI :: Maybe Text
    , optionsDebugOutputURI :: Maybe Text
    }
  deriving (Show)

--main :: IO ()
--main = do
--    options <- execParser optionsParser
--    putStrLn
--        (concat ["Hello, ", optVal options, ", the flag is ", show (optFlag options)])
--  where
optionsParser :: ParserInfo Options
optionsParser =
    info
        (helper <*> versionOption <*> programOptions)
        (fullDesc <> progDesc "optparse example" <>
         header
             "optparse-example - a small example program for optparse-applicative")
  where
    versionOption :: Parser (a -> a)
    versionOption = infoOption "0.0" (long "version" <> help "Show version")
    programOptions :: Parser Options
    programOptions =
        Options
          <$> optional (strOption $ long "signal" <> metavar "URI") -- value "default <> help ".."
          <*> optional (strOption $ long "control" <> metavar "URI")
          <*> optional (strOption $ long "debug" <> metavar "URI")



data Msg = Msg
    { msg_text :: Maybe Text
    } | Time { time_value :: Double }
  deriving (Show)

$(TH.deriveJSON TH.defaultOptions
  { TH.constructorTagModifier = Prelude.map Char.toLower
  , TH.fieldLabelModifier = Prelude.tail . Prelude.dropWhile (/='_')
  , TH.sumEncoding = TH.defaultTaggedObject { TH.tagFieldName = "type" }
  } ''Msg)


--parseJSONFromStream :: FromJSON a => InputStream ByteString -> IO a
--parseJSONFromStream = parseJSON <$> parseFromStream json'


handleFromURI = \case
  Just s | ["fd", Text.decimal -> Right (h, "")] <- Text.split (==':') s -> do
    -- TODO exceptions?
    Right . Just <$> fdToHandle h

  Just s ->
    return $ Left $ "unsupported URI: " <> s

  Nothing ->
    return $ Right Nothing


-- while jq -cn '[{type:"msg",value:"\(now)"},{"type":"time","value":now}][]'; do sleep 1; echo 121231.2; done | (exec 3<&0 4>&1 5>&2; exec  xterm -e ./read-jsons --signal=fd:3 --control=fd:4 --debug=fd:5)
main :: IO ()
main = do
    options <- execParser optionsParser
    print options

    jsonOut <- fdToHandle 4
    debugOutHandle <- fdToHandle 5

    -- TODO specify protocol
    -- TODO http+unix:/path/to/socket (TODO client vs server)
    -- TODO fd:
    maybeSignalInputHandle <- handleFromURI $ optionsSignalInputURI options

    case maybeSignalInputHandle of
      Right (Just signalInputHandle) -> do
        String.hPutStrLn debugOutHandle $ "signal input handle: " <> show signalInputHandle

        --let notEOF s = if ByteString.null s then Nothing else Just s
        -- TODO Data.ByteString.Extra.hGetMaybe
        let maybeSome = bool Nothing . Just <*> not . ByteString.null
        let hGetMaybe h c = maybeSome <$> ByteString.hGet h c

        let parse stream = Aeson.fromJSON <$> parseFromStream Aeson.json' stream :: IO (Aeson.Result Msg)


        makeInputStream (hGetMaybe signalInputHandle 1) >>= forever . ((>>=String.hPutStrLn debugOutHandle . show) . parse)
        -- TODO `catch` \e -> Prelude.putStrLn ("Caught " <> show (e :: ParseException))

      Right Nothing ->
          hPutStrLn debugOutHandle $ "signal input disabled"

      Left error -> do
          Text.hPutStrLn debugOutHandle $ "failed to open signal input: " <> error