test

qwertyuiop
asdfghjkl
zxcvbnm

TextTreeList.hs

{-# LANGUAGE 
    TemplateHaskell, 
    Rank2Types, 
    NoMonomorphismRestriction, 
    TypeOperators, 
    StandaloneDeriving,
    DeriveFunctor #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State
import           Control.Lens hiding ((<|), (|>))
import           Control.Zipper

import           Data.Sequence   (Seq, ViewL(..), ViewR(..), (<|), (|>), (><))
import qualified Data.Sequence as Seq
import           Data.Sequence.Lens
import           Data.Monoid
import           Data.Fix
import           Data.Functor.Compose
import           Data.Functor.Classes

{-
    type Node fileInfo lineInfo string = 
        recursive \itself ->
            fileInfo 
            & ( File: string => (lineInfo & string)
              | Dir:  string => itself 
              )

    Node is a[n fileInfo-annotated] tree being 
        either File - then it contains NamedSeq of lineInfo-annotated lines,
        or     Dir  - then it contains NamedSeq of Nodes,
-}

type Node fileInfo lineInfo string = Fix (Annotated fileInfo `Compose` Node_ lineInfo string)

data Node_ lineInfo string self
    = File_ { _file :: NamedTree string (lineInfo `Annotated` string) }
    | Dir_  { _dir  :: NamedTree string self }

    deriving Show

data Annotated a b = Annotated { _annotation :: a, _object :: b }
    deriving (Show, Functor)

data NamedTree string elem
    = NamedTree
        { _name :: string
        , _tree :: [elem]
        }
    deriving Show

-- meh
instance (Show a, Show b) => Show1 (Node_ a b)   where showsPrec1 = showsPrec
instance  Show a          => Show1 (Annotated a) where showsPrec1 = showsPrec

-- generating accessors
makeLenses ''Annotated
makePrisms ''Annotated

makeLenses ''Node_
makePrisms ''Node_

makeLenses ''NamedTree
makePrisms ''NamedTree

makePrisms ''Fix
makePrisms ''Compose

-- some custom accessors to ease the access through fixpoint 
-- and "compose-with-annotation" blocks
_File     = _Fix._Compose.object._File_
_Dir      = _Fix._Compose.object._Dir_
_NodeInfo = _Fix._Compose.annotation

test :: String -> IO (Top :>> Node () () String)
-- generate test zipper from file
test path = do
    text <- readFile path

    -- force text to materialize
    length text `seq` return ()

    -- transform text to the Seq[uence] of lines
    let ls = {-Seq.fromList $ -}map (Annotated ()) $ lines text

    -- wrap text with all shitty blocks and make a zipper out of it
    return $ zipper $ Fix (Compose (Annotated () (File_ (NamedTree path ls))))

hack1stFile :: Top :>> Node () () String -> IO (Top :>> Node () () String)
-- try access 2nd line of the file
hack1stFile cursor = do
    atName <- (_File.tree.traverse) `within` cursor
    atName <- rightward atName
    atName <- object `within` atName

    let newName = atName & focus .~ "HACKED"

    return (upward (upward newName))
    
main = test "test" >>= hack1stFile >>= print . rezip

TextTreeSeq.hs

{-# LANGUAGE 
    TemplateHaskell, 
    Rank2Types, 
    NoMonomorphismRestriction, 
    TypeOperators, 
    StandaloneDeriving,
    DeriveFunctor #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State
import           Control.Lens hiding ((<|), (|>))
import           Control.Zipper

import           Data.Sequence   (Seq, ViewL(..), ViewR(..), (<|), (|>), (><))
import qualified Data.Sequence as Seq
import           Data.Sequence.Lens
import           Data.Monoid
import           Data.Fix
import           Data.Functor.Compose
import           Data.Functor.Classes

{-
    type Node fileInfo lineInfo string = 
        recursive \itself ->
            fileInfo 
            & ( File: string => (lineInfo & string)
              | Dir:  string => itself 
              )

    Node is a[n fileInfo-annotated] tree being 
        either File - then it contains NamedSeq of lineInfo-annotated lines,
        or     Dir  - then it contains NamedSeq of Nodes,
-}

type Node fileInfo lineInfo string = Fix (Annotated fileInfo `Compose` Node_ lineInfo string)

data Node_ lineInfo string self
    = File_ { _file :: NamedTree string (lineInfo `Annotated` string) }
    | Dir_  { _dir  :: NamedTree string self }

    deriving Show

data Annotated a b = Annotated { _annotation :: a, _object :: b }
    deriving (Show, Functor)

data NamedTree string elem
    = NamedTree
        { _name :: string
        , _tree :: Seq elem
        }
    deriving Show

-- meh
instance (Show a, Show b) => Show1 (Node_ a b)   where showsPrec1 = showsPrec
instance  Show a          => Show1 (Annotated a) where showsPrec1 = showsPrec

-- generating accessors
makeLenses ''Annotated
makePrisms ''Annotated

makeLenses ''Node_
makePrisms ''Node_

makeLenses ''NamedTree
makePrisms ''NamedTree

makePrisms ''Fix
makePrisms ''Compose

-- some custom accessors to ease the access through fixpoint 
-- and "compose-with-annotation" blocks
_File     = _Fix._Compose.object._File_
_Dir      = _Fix._Compose.object._Dir_
_NodeInfo = _Fix._Compose.annotation

test :: String -> IO (Top :>> Node () () String)
-- generate test zipper from file
test path = do
    text <- readFile path

    -- force text to materialize
    length text `seq` return ()

    -- transform text to the Seq[uence] of lines
    let ls = Seq.fromList $ map (Annotated ()) $ lines text

    -- wrap text with all shitty blocks and make a zipper out of it
    return $ zipper $ Fix (Compose (Annotated () (File_ (NamedTree path ls))))

hack1stFile :: Top :>> Node () () String -> IO (Top :>> Node () () String)
-- try access 2nd line of the file
hack1stFile cursor = do
    atName <- (_File.tree.traverse) `within` cursor
    atName <- rightward atName
    atName <- object `within` atName

    let newName = atName & focus .~ "HACKED"

    return (upward (upward newName))
    
main = test "test" >>= hack1stFile >>= print . rezip