-- |
-- Module      :  Conllu.Print
-- Copyright   :  © 2018 bruno cuconato
-- License     :  LPGL-3
--
-- Maintainer  :  bruno cuconato <bcclaro+hackage@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- prints CoNLL-U.

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))

-- TODO: use some kind of bi-directional thing to derive this module

-- | Functional list type from LYHGG, see HUGHES, RJM. "A novel
-- representation of lists and its application to the function
-- 'reverse'"
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 []

---
-- printing
printDoc :: Doc -> String
-- | prints a list of sentences to a 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
-- | prints a sentence to a 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
printComments :: [Comment] -> FList Char
printComments =
  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

---
-- field printers
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)))

---
-- utility printers
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"