Fix vim syntax names.

[doclang.git] / Language / TCT / Write / Plain.hs

diff --git a/Language/TCT/Write/Plain.hs b/Language/TCT/Write/Plain.hs
index 5dcecce648096bf3499b98320054290b6a7ca402..e2d7148e3f4f249d099f340e8302bb32aa1fa107 100644 (file)
--- a/Language/TCT/Write/Plain.hs
+++ b/Language/TCT/Write/Plain.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.TCT.Write.Plain where
 
@@ -14,13 +13,13 @@ import Data.Foldable (Foldable(..))
 import Data.Function (($))
 import Data.Functor ((<$>))
 import Data.Int (Int)
+import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (Maybe(..))
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..), Ordering(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Sequence (ViewL(..))
 import Data.String (String, IsString(..))
-import Data.Tuple (fst)
 import Prelude (Num(..), error)
 import Text.Show (Show(..))
 import qualified Control.Monad.Trans.State as S
@@ -33,6 +32,9 @@ import Language.TCT
 import Language.TCT.Utils
 -- import Language.TCT.Debug
 
+writePlain :: Roots -> TL.Text
+writePlain doc = text (setStart doc def) doc
+
 -- * Type 'Plain'
 type Plain = S.State State TLB.Builder
  -- NOTE: To get maximum performance when building lazy Text values using a builder,
@@ -47,14 +49,11 @@ instance Monoid Plain where
        mappend = (<>)
 
 runPlain :: Plain -> State -> TL.Text
-runPlain p s = TLB.toLazyText $ fst $ S.runState p s
+runPlain p s = TLB.toLazyText $ S.evalState p s
 
 text :: Plainify a => State -> a -> TL.Text
 text s a = runPlain (plainify a) s
 
-plainDocument :: Roots -> TL.Text
-plainDocument doc = text (setStart doc def) doc
-
 -- ** Type 'State'
 data State
  =   State
@@ -88,7 +87,7 @@ setStart ts st = st
        where pos =
                case Seq.viewl ts of
                 EmptyL -> pos1
-                Tree Cell{cell_begin} _ :< _ -> cell_begin
+                Tree (Cell (Span{span_begin}:|_) _) _ :< _ -> span_begin
 
 -- * Class 'Plainify'
 class Plainify a where
@@ -146,18 +145,17 @@ instance Plainify Pos where
 instance Plainify Roots where
        plainify = foldMap plainify
 instance Plainify Root where
-       plainify (Tree (Cell bp _ep nod) ts) =
+       plainify (Tree (Cell (Span{span_begin=bp}:|_) nod) ts) =
                plainify bp <>
                case nod of
-               ----------------------
-                NodeGroup -> plainify ts
                ----------------------
                 NodeLower n as -> "<" <> plainify n <> plainify as <> plainify ts
                ----------------------
                 NodeHeader hdr ->
                        case hdr of
-                        HeaderGreat{} -> plainHeaderRepeated
-                        HeaderBar{}   -> plainHeaderRepeated
+                        HeaderGreat{}    -> plainHeaderRepeated
+                        HeaderBar{}      -> plainHeaderRepeated
+                        HeaderDotSlash{} -> plainify hdr
                         _ -> plainify hdr <> plainify ts
                        where
                        plainHeaderRepeated = do
@@ -209,7 +207,7 @@ instance Plainify Header where
                 HeaderDash        -> "- "
                 HeaderDashDash    -> "-- "
                 HeaderSection lvl -> plainify (List.replicate lvl '#')
-                HeaderDotSlash n  -> "./" <> plainify n
+                HeaderDotSlash n  -> plainify n
 instance Plainify Token where
        plainify = \case
         TokenText t -> plainify t