{-# LANGUAGE
    DoAndIfThenElse
  , UnicodeSyntax
  #-}
module Rakka.Validation
    ( getValidator
    )
    where
import Control.Applicative
import Control.Arrow.Unicode
import Control.Monad.Trans
import Control.Monad.Unicode
import Paths_Rakka
import System.Directory
import System.FilePath
import Text.XML.HXT.Arrow.XmlState
import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.RelaxNG

loadSchema ∷ FilePath → IO (IOSArrow XmlTree XmlTree)
loadSchema fpath
    = do [schema] ← runX ( setErrorMsgHandler False fail
                           ⋙
                           validateSchemaWithRelax fpath
                         )
         pure $ validateDocumentWithRelax schema

doesLocalDirExist ∷ IO Bool
doesLocalDirExist = doesDirectoryExist "schemas"

getValidator ∷ MonadIO m ⇒ FilePath → m (IOSArrow XmlTree XmlTree)
getValidator fname
    = liftIO $
      do let schemaPath = "schemas" </> fname
         localDirExists ← doesLocalDirExist
         if localDirExists then
             loadSchema schemaPath
         else
             getDataFileName ("schemas" </> fname) ≫= loadSchema