78 lines
3.0 KiB
Haskell
78 lines
3.0 KiB
Haskell
|
import Grammar
|
||
|
|
import Types
|
||
|
|
|
||
|
|
import Registry.Registry (readRegistry, isValid)
|
||
|
|
import Registry.Types
|
||
|
|
import Registry.Utils (onlyThisValue, onlyThisType, scriptFrom, languageFrom,
|
||
|
|
regionFrom, variantFrom)
|
||
|
|
|
||
|
|
import Data.List (intersperse)
|
||
|
|
import System.Environment (getArgs)
|
||
|
|
|
||
|
|
infile = "./language-subtag-registry"
|
||
|
|
|
||
|
|
langToString registry l =
|
||
|
|
"language \"" ++ concat (intersperse " / "
|
||
|
|
(lang'descr (languageFrom (filter (onlyThisValue
|
||
|
|
"language" l)
|
||
|
|
(filter (onlyThisType "language")
|
||
|
|
registry) !! 0)))) ++ "\""
|
||
|
|
|
||
|
|
scriptToString registry Nothing = ""
|
||
|
|
scriptToString registry (Just s) =
|
||
|
|
let theScript = (filter (onlyThisValue "script" s)
|
||
|
|
(filter (onlyThisType "script")
|
||
|
|
registry)) !! 0 in
|
||
|
|
", " ++ s ++ ": script " ++
|
||
|
|
" \"" ++ concat (intersperse " / " (script'descr
|
||
|
|
(scriptFrom theScript))) ++ "\""
|
||
|
|
|
||
|
|
regionToString registry Nothing = ""
|
||
|
|
regionToString registry (Just r) =
|
||
|
|
let theRegion = (filter (onlyThisValue "region" r)
|
||
|
|
(filter (onlyThisType "region")
|
||
|
|
registry)) !! 0 in
|
||
|
|
", " ++ r ++ ": region " ++
|
||
|
|
" \"" ++ concat (intersperse " / " (region'descr
|
||
|
|
(regionFrom theRegion))) ++ "\""
|
||
|
|
|
||
|
|
variantsToString registry [] = ""
|
||
|
|
variantsToString registry v = ", " ++ concat (intersperse ", "
|
||
|
|
(map (variantToString registry) v))
|
||
|
|
|
||
|
|
variantToString registry v =
|
||
|
|
let theVariant = (filter (onlyThisValue "variant" v)
|
||
|
|
(filter (onlyThisType "variant")
|
||
|
|
registry)) !! 0 in
|
||
|
|
v ++ ": variant " ++
|
||
|
|
" \"" ++ concat (intersperse " / " (variant'descr
|
||
|
|
(variantFrom theVariant))) ++ "\""
|
||
|
|
|
||
|
|
toString :: Registry -> Tag -> String
|
||
|
|
toString registry (Tag l el s r v e) =
|
||
|
|
-- TODO: display extlangs
|
||
|
|
l ++ ": " ++ langToString registry l ++
|
||
|
|
scriptToString registry s ++ regionToString registry r ++
|
||
|
|
variantsToString registry v
|
||
|
|
|
||
|
|
toString registry (Types.GF tag) = tag
|
||
|
|
toString registry (Priv p) =
|
||
|
|
(concat p) ++ " (private tag so no info available)"
|
||
|
|
|
||
|
|
analyze :: Registry -> String -> String
|
||
|
|
analyze reg input
|
||
|
|
= case (getTag input) of
|
||
|
|
Left err -> err
|
||
|
|
Right tag -> let result = isValid reg tag in
|
||
|
|
if fst result then
|
||
|
|
input ++ ": (" ++ (toString reg tag) ++ ")"
|
||
|
|
else
|
||
|
|
(input ++ " is NOT valid: " ++ snd result ++ "\n")
|
||
|
|
|
||
|
|
main = do
|
||
|
|
myargs <- getArgs
|
||
|
|
theregistry <- readRegistry infile
|
||
|
|
putStrLn (concat (intersperse "\n" (map (analyze theregistry) myargs)))
|
||
|
|
|
||
|
|
|