Main.hs

{-# LANGUAGE NamedFieldPuns #-}
module Main where

import CLI (Command(..), Input(..), getCommand)
import Control.Monad.Except (runExceptT)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text.IO as Text (getContents, readFile, writeFile)
import Text.InvisiXML (InvisiXML(..), parse)
import Text.XML.Light.Serializer (encode)
import System.FilePath ((<.>), dropExtension)

endPoints :: Command -> (IO Text, FilePath)
endPoints (Command {input = StdIn, outputPrefix}) =
  (Text.getContents, fromMaybe noOutputPrefix outputPrefix)
  where
    noOutputPrefix = error "output prefix (-o) is necessary when running on stdin"
endPoints (Command {input = FileInput f, outputPrefix}) =
  (Text.readFile f, fromMaybe (dropExtension f) outputPrefix)

run :: Command -> IO ()
run command =
  source >>= runExceptT . parse >>= either (fail . show) create
  where
    (source, prefix) = endPoints command
    create (InvisiXML {text, structure}) = do
      Text.writeFile (prefix <.> "txt") text
      writeFile (prefix <.> "ixml") $ encode structure

main :: IO ()
main = getCommand >>= run