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