Study StateMarkup.
[doclang.git] / Language / TCT / Tree.hs
index 0fa7e2c6877c7f017a8c25e03b8194ba000c7682..9ac9dd944c615638f1e7cbf547d1f65cd1bc7ae7 100644 (file)
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Language.TCT.Tree where
+module Language.TCT.Tree
+ ( module Language.TCT.Tree
+ , Tree(..)
+ , Trees
+ ) where
 
-import Control.Applicative (Applicative(..))
-import Data.Bool
 import Data.Eq (Eq(..))
-import Data.Foldable (Foldable(..))
-import Data.Foldable (foldr)
-import Data.Function (($), (.))
-import Data.Functor (Functor, (<$>))
+import Data.Function (($))
+import Data.Functor ((<$>))
 import Data.Maybe (Maybe(..))
 import Data.Ord (Ordering(..), Ord(..))
 import Data.Semigroup (Semigroup(..))
-import Data.Sequence (Seq, ViewL(..), (|>))
+import Data.Sequence ((|>))
 import Data.Text (Text)
-import Data.Traversable (Traversable(..))
+import Data.TreeSeq.Strict (Tree(..), Trees)
 import Prelude (undefined, Int, Num(..))
 import Text.Show (Show(..))
 import qualified Data.List as List
-import qualified Data.Sequence as Seq
 import qualified Data.Text as Text
 import qualified System.FilePath as FP
 
+import Language.TCT.Cell
 import Language.TCT.Elem
 
--- * Type 'Tree'
-data Tree k a
- =   TreeN k (Trees k a)
- |   Tree0 a
- deriving (Eq, Show, Functor)
-
-instance Traversable (Tree k) where
-       traverse f (Tree0 a)    = Tree0 <$> f a
-       traverse f (TreeN k ts) = TreeN k <$> traverse (traverse f) ts
-       sequenceA (Tree0 a)     = Tree0 <$> a
-       sequenceA (TreeN k ts)  = TreeN k <$> traverse sequenceA ts
-instance Foldable (Tree k) where
-       foldMap f (TreeN _k ts) = foldMap (foldMap f) ts
-       foldMap f (Tree0 k)     = f k
-
-isTree0 :: Tree k a -> Bool
-isTree0 Tree0{} = True
-isTree0 _       = False
-
-mapTreeWithKey :: (Maybe k -> a -> b) -> Tree k a -> Tree k b
-mapTreeWithKey = go Nothing
-       where
-       go _k f (TreeN k ts) = TreeN k (go (Just k) f <$> ts)
-       go k  f (Tree0 a)    = Tree0 (f k a)
-
-mapTreeKey :: (k -> l) -> (Maybe k -> a -> b) -> Tree k a -> Tree l b
-mapTreeKey fk fv = go Nothing
-       where
-       go _k (TreeN k ts) = TreeN (fk k) $ go (Just k) <$> ts
-       go k  (Tree0 a)    = Tree0 (fv k a)
-
-traverseTreeWithKey :: Applicative f => (Maybe k -> a -> f b) -> Tree k a -> f (Tree k b)
-traverseTreeWithKey = go Nothing
-       where
-       go _p f (TreeN k ts) = TreeN k <$> traverse (go (Just k) f) ts
-       go p  f (Tree0 a)    = Tree0 <$> f p a
-
--- ** Type 'Trees'
-type Trees k a = Seq (Tree k a)
-
-newtype PrettyTree k a = PrettyTree (Trees k a)
-instance (Show k, Show a) => Show (PrettyTree k a) where
-       show (PrettyTree t) = Text.unpack $ prettyTrees t
-
-prettyTree :: (Show k, Show a) => Tree k a -> Text
-prettyTree = Text.unlines . pretty
-
-prettyTrees :: (Show k, Show a) => Trees k a -> Text
-prettyTrees = foldr (\t acc -> prettyTree t <> "\n" <> acc) ""
-
-pretty :: (Show k, Show a) => Tree k a -> [Text]
-pretty (Tree0 a)     = [Text.pack (show a)]
-pretty (TreeN k ts0) = Text.pack (show k) : prettySubTrees ts0
-       where
-       prettySubTrees s =
-               case Seq.viewl s of
-                Seq.EmptyL -> []
-                t:<ts | Seq.null ts -> "|" : shift "`- " "   " (pretty t)
-                      | otherwise   -> "|" : shift "+- " "|  " (pretty t) <> prettySubTrees ts
-       shift first other = List.zipWith (<>) (first : List.repeat other)
-
--- * Type 'Pos'
-data Pos = Pos {-# UNPACK #-} !Line {-# UNPACK #-} !Column
- deriving (Eq, Show)
-
-posTree :: Tree (Cell k) (Cell a) -> Pos
-posTree (TreeN c _) = posCell c
-posTree (Tree0 c)   = posCell c
-
-posEndTree :: Tree (Cell k) (Cell a) -> Pos
-posEndTree (TreeN c _) = posEndCell c
-posEndTree (Tree0 c)   = posEndCell c
-
-pos0 :: Pos
-pos0 = Pos 0 0
-pos1 :: Pos
-pos1 = Pos 1 1
-
--- ** Type 'Line'
--- | Line in the source file, counting from 1.
-type Line = Int
-linePos :: Pos -> Line
-linePos (Pos l _) = l
-
--- ** Type 'Column'
--- | Column in the source file, counting from 1.
-type Column = Int
-columnPos :: Pos -> Column
-columnPos (Pos _ c) = c
-
 -- * Type 'Row'
 -- | A list of 'Key's, maybe ended by 'Value', all read on the same 'Line'.
 type Row = [Tree (Cell Key) (Cell Text)]
 
--- ** Type 'Cell'
--- | NOTE: every 'Cell' as a 'Pos',
---         which is useful to indicate matches/errors/warnings/whatever,
---         or outputing in a format somehow preserving
---         the original input style.
-data Cell a = Cell {-# UNPACK #-} !Pos {-# UNPACK #-} !Pos a
-              deriving (Eq, Show)
-
-unCell :: Cell a -> a
-unCell (Cell _ _ a) = a
-
-posCell :: Cell a -> Pos
-posCell (Cell pos _ _) = pos
-posEndCell :: Cell a -> Pos
-posEndCell (Cell _ pos _) = pos
-
-lineCell :: Cell a -> Line
-lineCell = linePos . posCell
-columnCell :: Cell a -> Column
-columnCell = columnPos . posCell
-
-cell0 :: a -> Cell a
-cell0 = Cell pos0 pos0
-cell1 :: a -> Cell a
-cell1 = Cell pos1 pos1
-
 -- * Type 'Key'
 data Key = KeyColon !Name !White     -- ^ @name: @
          | KeyEqual !Name !White     -- ^ @name=@
@@ -156,7 +39,7 @@ data Key = KeyColon !Name !White     -- ^ @name: @
          | KeySection  !LevelSection -- ^ @# @
          | KeyBrackets !Name         -- ^ @[ name ]@
          | KeyDotSlash !PathFile     -- ^ @./file @
-         deriving (Eq, Show)
+         deriving (Eq, Ord, Show)
 
 -- ** Type 'Name'
 type Name = Text