GaBuZoMeu/display-tag.hs

79 lines
3.1 KiB
Haskell
Raw Normal View History

2023-06-08 21:49:35 +02:00
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) =
2023-10-01 16:05:58 +02:00
-- Display extlangs. See issue #8
-- Display extensions. See issue #7
2023-06-08 21:49:35 +02:00
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)))