1 module Rakka.Validation
6 import Control.Arrow.ArrowList
7 import Control.Arrow.ArrowTree
8 import Control.Monad.Reader
9 import Paths_Rakka -- Cabal が用意する。
10 import Rakka.Environment
11 import System.Directory
12 import System.FilePath
13 import Text.XML.HXT.Arrow.XmlArrow
14 import Text.XML.HXT.DOM.TypeDefs
16 loadSchema :: FilePath -> IO (IOSArrow XmlTree XmlTree)
18 = do [schema] <- runX ( setErrorMsgHandler False fail
22 perform (validateWithRelaxAndHandleErrors S.relaxSchemaArrow)
24 createSimpleForm [] True True True
28 getChildren >>> getAttrValue "desc"
30 arr ("Relax NG validation: " ++ )
37 return $ validateDocumentWithRelax schema
40 doesLocalDirExist :: IO Bool
41 doesLocalDirExist = doesDirectoryExist "schemas"
44 getValidator :: MonadIO m => Environment -> FilePath -> m (IOSArrow XmlTree XmlTree)
47 do let schemaPath = "schemas" </> fname
49 localDirExists <- doesLocalDirExist
50 if localDirExists then
53 getDataFileName ("schemas" </> fname) >>= loadSchema