module Conllu.Print
( printDoc
, printSent )
where
import qualified Conllu.DeprelTagset as D
import Conllu.Type
import Conllu.Utils
import Data.List
import Data.Maybe
import Data.Semigroup
import Data.Monoid (Monoid(mempty, mappend))
newtype FList a = FList { getFList :: [a] -> [a] }
instance Semigroup (FList a) where
(FList f) <> (FList g) = FList (f . g)
instance Monoid (FList a) where
mempty = FList (\xs -> [] ++ xs)
a `mappend` b = a <> b
toFList :: [a] -> FList a
toFList xs = FList (xs++)
fromFList :: FList a -> [a]
fromFList (FList f) = f []
printDoc :: Doc -> String
printDoc =
fromFList . mconcat . map (\s -> printSent' s `mappend` diffLSpace)
printSent :: Sent -> String
printSent = fromFList . printSent'
printSent' :: Sent -> FList Char
printSent' ss =
mconcat
[ printComments (_meta ss)
, diffLSpace
, printWs (_words ss)
]
printComments :: [Comment] -> FList Char
printComments =
toFList .
intercalate "\n" .
map
(\(c1, c2) ->
concat
[ "# "
, c1
, if null c2
then ""
else "= " ++ c2
])
printWs :: [CW a] -> FList Char
printWs = foldr (\w dl -> mconcat [printW w, diffLSpace, dl]) mempty
printW :: CW a -> FList Char
printW = printW'
where
printW' :: CW a -> FList Char
printW' w =
wordLine w
[ printID'
, printFORM
, printLEMMA
, printUPOS'
, printXPOS
, printFEATS'
, printHEAD
, printDEPREL'
, printDEPS'
, printMISC
]
wordLine :: CW a -> [CW a -> String] -> FList Char
wordLine w = toFList . intercalate "\t" . map (\f -> f w)
printID' = printID . _id
printMStr = fromMaybe "_"
printFORM = printMStr . _form
printLEMMA = printMStr . _lemma
printUPOS' = printUPOS . _upos
printXPOS = printMStr . _xpos
printFEATS' = printFEATS . _feats
printHEAD = maybe "_" (printID . _head) . _rel
printDEPREL' =
maybe "_" (\r -> printDEPREL (_deprel r) (_subdep r)) . _rel
printDEPS' = printDEPS . _deps
printMISC = printMStr . _misc
printID :: ID -> String
printID id' =
case id' of
SID i -> show i
MID s e -> concat [show s, "-", show e]
EID i e -> concat [show i, ".", show e]
printUPOS :: UPOS -> String
printUPOS Nothing = "_"
printUPOS (Just pos) = show pos
printFEATS :: FEATS -> String
printFEATS = printList printFeat
where
printFeat Feat {_feat = f, _featValues = vs, _featType = mft} =
let fts = maybe "" (\ft -> "[" ++ ft ++ "]") mft
in concat [f, fts, "=", intercalate "," vs]
printDEPREL :: D.EP -> Maybe String -> String
printDEPREL dr sdr =
downcaseStr $ show dr ++ maybe "" (":" ++) sdr
printDEPS :: DEPS -> String
printDEPS =
printList
(\r ->
intercalate
":"
([printID (_head r), printDEPREL (_deprel r) (_subdep r)] ++
fromMaybe [] (_rest r)))
printList :: (a -> String) -> [a] -> String
printList f = nullToStr . intercalate "|" . map f
where
nullToStr :: String -> String
nullToStr xs =
if null xs
then "_"
else xs
diffLSpace :: FList Char
diffLSpace = toFList "\n"