diff --git a/NLP/Concraft.hs b/NLP/Concraft.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module NLP.Concraft
+( GuessConf (..)
+, GuessData (..)
+, DisambConf (..)
+, DisambWith (..)
+, DisambTag
+, DisambTrain
+, disamb
+, disambDoc
+, trainOn
+) where
+
+-- import Data.Binary (Binary, put, get)
+-- import qualified Data.Text as T
+
+import System.IO (hClose)
+import Data.Foldable (Foldable)
+import qualified Data.Text.Lazy as L
+import qualified Data.Text.Lazy.IO as L
+import qualified Numeric.SGD as SGD
+import qualified System.IO.Temp as Temp
+
+import NLP.Concraft.Schema
+import qualified NLP.Concraft.Morphosyntax as Mx
+import qualified NLP.Concraft.Format as F
+import qualified NLP.Concraft.Guess as G
+import qualified NLP.Concraft.Disamb as D
+
+-- | Guessing configuration.
+data GuessConf r = GuessConf
+    { guessNum      :: Int
+    , guessSchema   :: Schema r () }
+
+-- | Guessing configuration and model data.
+data GuessData r = GuessData
+    { guessConf     :: GuessConf r
+    , guesser       :: G.Guesser r }
+
+-- | Disambiguation configuration.
+data DisambConf r t = DisambConf
+    { split         :: D.Split r t
+    , disambSchema  :: Schema t () }
+
+-- | Disambiguation configuration with...
+data DisambWith r t a = DisambWith
+    { disambConf    :: DisambConf r t
+    , disambWith    :: a }
+
+-- | Tagging with disambiguation configuration.
+type DisambTag r t = DisambWith r t (D.TagCRF Ob t)
+
+-- | Training disambiguation model configuration.
+type DisambTrain r t c = DisambWith r t (D.TrainCRF Ob t c)
+
+-- | Perform disambiguation preceded by context-sensitive guessing.
+disamb
+    :: (Ord r, Ord t)
+    => GuessData r      -- ^ Guessing configuration
+    -> DisambTag r t    -- ^ Disambiguation configuration
+    -> Mx.Sent r        -- ^ Input
+    -> [r]              -- ^ Output
+disamb GuessData{..} DisambWith{..} sent
+    = D.disamb disambSchema split tagCRF
+    . G.include sent 
+    . G.guess guessNum guessSchema guesser 
+    $ sent
+  where
+    GuessConf{..}   = guessConf
+    DisambConf{..}  = disambConf
+    tagCRF          = disambWith
+
+-- | Tag the sentence.
+disambSent
+    :: Ord t
+    => F.Sent s w
+    -> GuessData F.Tag
+    -> DisambTag F.Tag t
+    -> s -> s
+disambSent sentH GuessData{..} DisambWith{..}
+    = D.disambSent sentH disambSchema split tagCRF
+    . G.guessSent  sentH guessNum guessSchema guesser
+  where
+    GuessConf{..}   = guessConf
+    DisambConf{..}  = disambConf
+    tagCRF          = disambWith
+
+-- | Tag document.
+disambDoc
+    :: (Functor f, Ord t)
+    => F.Doc f s w          -- ^ Document format handler
+    -> GuessData F.Tag      -- ^ Guessing configuration
+    -> DisambTag F.Tag t    -- ^ Disambiguation configuration
+    -> L.Text               -- ^ Input
+    -> L.Text               -- ^ Output
+disambDoc F.Doc{..} guessData disambTag  =
+    let onSent = disambSent sentHandler guessData disambTag
+    in  showDoc . fmap onSent . parseDoc
+
+-- | Train guessing and disambiguation models.
+trainOn
+    :: (Functor f, Foldable f, Ord t)
+    => F.Doc f s w              -- ^ Document format handler
+    -> GuessConf F.Tag          -- ^ Guessing configuration
+    -> SGD.SgdArgs              -- ^ SGD params for guesser
+    -> DisambTrain F.Tag t c    -- ^ Disambiguation configuration
+    -> FilePath                 -- ^ Training file
+    -> Maybe FilePath           -- ^ Maybe eval file
+    -> IO (G.Guesser F.Tag, c)  -- ^ Resultant models
+trainOn format guessConf@GuessConf{..} sgdArgs DisambWith{..}
+        trainPath evalPath'Maybe = do
+    putStrLn "\n===== Train guessing model ====\n"
+    guesser <- G.trainOn format guessSchema sgdArgs
+                    trainPath evalPath'Maybe
+    let guessData = GuessData guessConf guesser
+    let withGuesser = guessFile format guessData
+    withGuesser "train" (Just trainPath) $ \(Just trainPathG) ->
+      withGuesser "eval"   evalPath'Maybe  $ \evalPathG'Maybe  -> do
+        putStrLn "\n===== Train disambiguation model ====\n"
+        let DisambConf{..} = disambConf
+        let trainCRF = disambWith
+        disambCRF <- D.trainOn format disambSchema split trainCRF
+                        trainPathG evalPathG'Maybe
+        return (guesser, disambCRF)
+
+guessFile
+    :: Functor f
+    => F.Doc f s w              -- ^ Document format handler
+    -> GuessData F.Tag          -- ^ Guesser
+    -> String                   -- ^ Template for temporary file name
+    -> Maybe FilePath           -- ^ File to guess
+    -> (Maybe FilePath -> IO a) -- ^ Handler
+    -> IO a
+guessFile _ _ _ Nothing handler = handler Nothing
+guessFile format GuessData{..} tmpl (Just path) handler =
+    Temp.withTempFile "." tmpl $ \tmpPath tmpHandle -> do
+        inp <- L.readFile path
+        let GuessConf{..} = guessConf
+        let out = G.guessDoc format guessNum guessSchema guesser inp
+	hClose tmpHandle
+        L.writeFile tmpPath out
+        handler (Just tmpPath)
diff --git a/NLP/Concraft/Disamb.hs b/NLP/Concraft/Disamb.hs
--- a/NLP/Concraft/Disamb.hs
+++ b/NLP/Concraft/Disamb.hs
@@ -1,198 +1,147 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 
 module NLP.Concraft.Disamb
-( Tier (..)
-, Tag (..)
-, select
-, splitWord
-, splitSent
-, Ox
-, Schema
-, Ob
-, schema
-, schematize
-, TierConf
-, tear
-, deTear
-, deTears
-, Disamb
+( Split
+, TrainCRF
+, TagCRF
 , disamb
-, tagFile
-, learn
+, disambSent
+, disambDoc
+, trainOn
 ) where
 
-import Control.Applicative ((<$>), (<*>))
+import Control.Applicative ((<$>))
 import Data.Maybe (fromJust)
 import Data.List (find)
+import Data.Foldable (Foldable, foldMap)
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as L
 import qualified Data.Vector as V
-
-import Data.Binary (Binary, get, put)
-import Data.Text.Binary ()
+import qualified Data.Text.Lazy as L
+import qualified Data.Text.Lazy.IO as L
 
 import qualified Control.Monad.Ox as Ox
-import qualified Data.CRF.Chain2.Pair as CRF
-import qualified Numeric.SGD as SGD
-import qualified Data.Tagset.Positional as TP
-
-import NLP.Concraft.Morphosyntax
-import qualified NLP.Concraft.Plain as P
-
--- | A tier description.
-data Tier = Tier {
-    -- | Does it include the part of speech?
-      withPos   :: Bool
-    -- | Tier grammatical attributes.
-    , withAtts  :: S.Set TP.Attr }
-
-instance Binary Tier where
-    put Tier{..} = put withPos >> put withAtts
-    get = Tier <$> get <*> get
-
--- | A tag with optional POS.
-data Tag = Tag
-    { pos   :: Maybe TP.POS
-    , atts  :: M.Map TP.Attr T.Text }
-    deriving (Show, Eq, Ord)
-
-instance Binary Tag where
-    put Tag{..} = put pos >> put atts
-    get = Tag <$> get <*> get
-
--- | Select tier attributes.
-select :: Tier -> TP.Tag -> Tag
-select Tier{..} tag = Tag
-    { pos   = if withPos then Just (TP.pos tag) else Nothing
-    , atts  = M.filterWithKey (\k _ -> k `S.member` withAtts) (TP.atts tag) }
-
--- | The Ox monad specialized to word token type and text observations.
--- TODO: Move to monad-ox package from here and from the nerf library.
-type Ox t a = Ox.Ox (Word t) T.Text a
-
--- | A schema is a block of the Ox computation performed within the
--- context of the sentence and the absolute sentence position.
-type Schema t a = V.Vector (Word t) -> Int -> Ox t a
-
--- | An observation consist of an index (of list type) and an actual
--- observation value.
-type Ob = ([Int], T.Text)
+import qualified Data.CRF.Chain2.Generic.External as CRF
 
-schema :: Schema t ()
-schema sent = \k -> do
-    mapM_ (Ox.save . lowOrth) [k - 1, k, k + 1]
-  where
-    at          = Ox.atWith sent
-    lowOrth i   = T.toLower <$> orth `at` i
+import NLP.Concraft.Schema
+import qualified NLP.Concraft.Morphosyntax as Mx
+import qualified NLP.Concraft.Format as F
 
--- | Schematize the input sentence according to 'schema' rules.
-schematize :: Sent t -> CRF.Sent Ob t
-schematize sent =
+-- | Schematize the input sentence with according to 'schema' rules.
+schematize :: Schema t a -> Mx.Sent t -> CRF.Sent Ob t
+schematize schema sent =
     [ CRF.mkWord (obs i) (lbs i)
     | i <- [0 .. n - 1] ]
   where
     v = V.fromList sent
     n = V.length v
     obs = S.fromList . Ox.execOx . schema v
-    lbs = tags . (v V.!)
-
-type TierConf = (Tier, Tier)
-
-tear :: TierConf -> TP.Tag -> (Tag, Tag)
-tear (t1, t2) = (,) <$> select t1 <*> select t2
+    lbs i = Mx.interpsSet w
+        where w = v V.! i
 
--- | Split tags between two layers.
--- TODO: Add support for multiple layers.
-splitWord :: TierConf -> Word TP.Tag -> Word (Tag, Tag)
-splitWord cfg = mapWord (tear cfg)
+-- | Split is just a function from an original tag form
+-- to a complex tag form.
+type Split r t = r -> t
 
-splitSent :: TierConf -> Sent TP.Tag -> Sent (Tag, Tag)
-splitSent ts = map (splitWord ts)
+-- | Unsplit the complex tag (assuming, that it is one
+-- of the interpretations of the word).
+unSplit :: Eq t => Split r t -> Mx.Word r -> t -> r
+unSplit split' word x = fromJust $ find ((==x) . split') (Mx.interps word)
 
--- | The disambiguation model.
-data Disamb = Disamb
-    { crf       :: CRF.CRF Ob Tag Tag
-    , tagset    :: TP.Tagset
-    , tierConf  :: TierConf }
+-- | CRF training function.
+type TrainCRF o t c
+    =  IO [CRF.SentL o t]           -- ^ Training data 'IO' action
+    -> Maybe (IO [CRF.SentL o t])   -- ^ Maybe evalation data
+    -> IO c                         -- ^ Resulting model
 
-instance Binary Disamb where
-    put Disamb{..} = put crf >> put tagset >> put tierConf
-    get = Disamb <$> get <*> get <*> get
+-- | CRF tagging function.
+type TagCRF o t = CRF.Sent o t -> [t]
 
--- | Determine the most probable label sequence.
-disamb :: Disamb -> Sent TP.Tag -> [TP.Tag]
-disamb Disamb{..} sent
-    = deTears tierConf sent
-    . CRF.tag crf
-    . schematize
-    . splitSent tierConf
+-- | Perform context-sensitive disambiguation.
+disamb
+    :: (Ord r, Ord t)
+    => Schema t a
+    -> Split r t
+    -> TagCRF Ob t
+    -> Mx.Sent r
+    -> [r]
+disamb schema split tag sent
+    = map (uncurry embed)
+    . zip sent
+    . tag
+    . schematize schema
+    . Mx.mapSent split
     $ sent
-
-deTears :: TierConf -> Sent TP.Tag -> [(Tag, Tag)] -> [TP.Tag]
-deTears cfg sent tiered =
-    [ deTear cfg word pair
-    | (word, pair) <- zip sent tiered ]
-
--- | Unsplit the list of tag pairs.  TODO: It can be done without the
--- help of original word.
-deTear :: TierConf -> Word TP.Tag -> (Tag, Tag) -> TP.Tag
-deTear cfg word tiered =
-    fromJust $ find
-        ((==tiered) . tear cfg)
-        (S.toList $ tags word)
+  where
+    embed = unSplit split
 
--- | Tag the file.
-tagFile
-    :: T.Text           -- ^ Tag indicating unknown words
-    -> Disamb
-    -> FilePath         -- ^ File to tag (plain format)
-    -> IO L.Text
-tagFile ign dmb path =
-    P.showPlain ign . map onSent <$> P.readPlain ign path
+-- | Tag the sentence.
+disambSent
+    :: Ord t
+    => F.Sent s w
+    -> Schema t a
+    -> Split F.Tag t
+    -> TagCRF Ob t
+    -> s -> s
+disambSent F.Sent{..} schema split tag sent =
+  flip mergeSent sent
+    [ select wMap orig
+    | (wMap, orig) <- zip
+        (doDmb sent)
+        (parseSent sent) ]
   where
-    onSent sent =
-        [ choose tok y
-        | (tok, y) <- zip sent ys ]
-      where
-        rs = map (fst . P.fromTok) sent
-        xs = map (mapWord parseTag) rs
-        ys = map showTag (disamb dmb xs)
-        choose tok y = P.choose tok (S.singleton y)
-        parseTag = TP.parseTag (tagset dmb)
-        showTag  = TP.showTag (tagset dmb)
+    F.Word{..} = wordHandler
+    doDmb orig =
+        let xs = map extract (parseSent orig)
+        in  map (uncurry mkChoice) (zip xs (disamb schema split tag xs))
+    mkChoice word x = Mx.mkWMap
+        [ if x == y
+            then (x, 1)
+            else (y, 0)
+        | y <- Mx.interps word ]
 
--- | TODO: Abstract over the format type.
-learn
-    :: SGD.SgdArgs      -- ^ SGD parameters 
-    -> FilePath         -- ^ File with positional tagset definition
-    -> T.Text        	-- ^ The tag indicating unknown words
-    -> TierConf         -- ^ Tiered tagging configuration
-    -> FilePath         -- ^ Train file (plain format)
+-- | Disambiguate document.
+disambDoc
+    :: (Functor f, Ord t)
+    => F.Doc f s w      -- ^ Document format handler
+    -> Schema t a       -- ^ Observation schema
+    -> Split F.Tag t    -- ^ Tiered tagging
+    -> TagCRF Ob t      -- ^ CRF tagging function
+    -> L.Text           -- ^ Input
+    -> L.Text           -- ^ Output
+disambDoc F.Doc{..} schema split tag =
+    let onSent = disambSent sentHandler schema split tag
+    in  showDoc . fmap onSent . parseDoc
+
+-- | Train disamb model.
+trainOn
+    :: (Foldable f, Ord t)
+    => F.Doc f s w      -- ^ Document format handler
+    -> Schema t a       -- ^ Observation schema
+    -> Split F.Tag t    -- ^ Tiered tagging
+    -> TrainCRF Ob t c  -- ^ CRF training function
+    -> FilePath         -- ^ Training file
     -> Maybe FilePath   -- ^ Maybe eval file
-    -> IO Disamb
-learn sgdArgs tagsetPath ign tierConf trainPath evalPath'Maybe = do
-    _tagset <- TP.parseTagset tagsetPath <$> readFile tagsetPath
-    _crf <- CRF.train sgdArgs
-        (schemed _tagset ign tierConf trainPath)
-        (schemed _tagset ign tierConf <$> evalPath'Maybe)
-    return $ Disamb _crf _tagset tierConf
+    -> IO c             -- ^ Resultant model data
+trainOn format schema split train trainPath evalPath'Maybe = do
+    crf <- train
+        (schemed format schema split trainPath)
+        (schemed format schema split <$> evalPath'Maybe)
+    return crf
 
 -- | Schematized data from the plain file.
 schemed
-    :: TP.Tagset -> T.Text -> TierConf
-    -> FilePath -> IO [CRF.SentL Ob (Tag, Tag)]
-schemed tagset _ign cfg =
-    fmap (map onSent) . P.readPlain _ign
+    :: (Foldable f, Ord t)
+    => F.Doc f s w -> Schema t a -> Split F.Tag t
+    -> FilePath -> IO [CRF.SentL Ob t]
+schemed F.Doc{..} schema split path =
+    foldMap onSent . parseDoc <$> L.readFile path
   where
+    F.Sent{..} = sentHandler
+    F.Word{..} = wordHandler
     onSent sent =
-        zip (schematize xs') (map mkDist ys')
+        [zip (schematize schema xs) (map mkDist xs)]
       where
-        (xs, ys) = unzip (map P.fromTok sent)
-        xs' = map (mapWord   smash) xs
-        ys' = map (mapChoice smash) ys
-        smash = tear cfg . parseTag
-        parseTag = TP.parseTag tagset
-        mkDist = CRF.mkDist . M.toList . M.map unPositive
+        xs  = map (Mx.mapWord split . extract) (parseSent sent)
+        mkDist = CRF.mkDist . M.toList . Mx.unWMap . Mx.tagWMap
diff --git a/NLP/Concraft/Disamb/Positional.hs b/NLP/Concraft/Disamb/Positional.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Disamb/Positional.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The module provides functions for splitting positional tags.
+-- They can be used together with the layered disambiguation model.
+
+module NLP.Concraft.Disamb.Positional
+( Tier (..)
+, Part (..)
+, select
+, split
+, tierConfDefault
+) where
+
+import Control.Applicative ((<$>), (<*>))
+import Data.Binary (Binary, put, get)
+import Data.Text.Binary ()
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Tagset.Positional as TP
+
+-- | A tier description.
+data Tier = Tier {
+    -- | Does it include the part of speech?
+      withPos   :: Bool
+    -- | Tier grammatical attributes.
+    , withAtts  :: S.Set TP.Attr }
+
+instance Binary Tier where
+    put Tier{..} = put withPos >> put withAtts
+    get = Tier <$> get <*> get
+
+-- | An atomic part of morphosyntactic tag with optional POS.
+data Part = Part
+    { pos   :: Maybe TP.POS
+    , atts  :: M.Map TP.Attr T.Text }
+    deriving (Show, Eq, Ord)
+
+instance Binary Part where
+    put Part{..} = put pos >> put atts
+    get = Part <$> get <*> get
+
+-- | Select tier attributes.
+select :: Tier -> TP.Tag -> Part
+select Tier{..} tag = Part
+    { pos   = if withPos then Just (TP.pos tag) else Nothing
+    , atts  = M.filterWithKey (\k _ -> k `S.member` withAtts) (TP.atts tag) }
+
+-- | Split the positional tag.
+split :: [Tier] -> TP.Tag -> [Part]
+split tiers tag =
+    [ select tier tag
+    | tier <- tiers ]
+
+-- | Default tiered tagging configuration.
+tierConfDefault :: [Tier]
+tierConfDefault =
+    [tier1, tier2]
+  where
+    tier1 = Tier True $ S.fromList ["cas", "per"]
+    tier2 = Tier False $ S.fromList
+        [ "nmb", "gnd", "deg", "asp" , "ngt", "acm"
+        , "acn", "ppr", "agg", "vlc", "dot" ]
diff --git a/NLP/Concraft/Disamb/Tiered.hs b/NLP/Concraft/Disamb/Tiered.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Disamb/Tiered.hs
@@ -0,0 +1,265 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE BangPatterns #-}
+
+module NLP.Concraft.Disamb.Tiered
+(
+-- * Tiered model
+  Ob (..)
+, Lb (..)
+, Feat (..)
+, CRF (..)
+, train
+, tag
+
+-- * Feature selection
+, FeatSel
+, selectHidden
+, selectPresent
+) where
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Comonad.Trans.Store (store)
+import Control.Monad (guard)
+import Data.Ix (Ix, inRange, range)
+import Data.Maybe (catMaybes, fromJust)
+import Data.List (zip4, foldl1')
+import Data.Lens.Common (Lens(..))
+import Data.Binary (Binary, get, put, Put, Get)
+import Data.Vector.Binary ()
+import qualified Data.Map as M
+import qualified Data.Vector as V
+import qualified Data.Array.Unboxed as A
+
+import Data.CRF.Chain2.Generic.Codec
+    ( Codec(..), mkCodec, encodeDataL
+    , encodeSent, decodeLabels, unJust )
+import Data.CRF.Chain2.Generic.Model
+    ( FeatGen(..), Model, FeatSel
+    , selectHidden, selectPresent
+    , core, withCore )
+import Data.CRF.Chain2.Generic.Internal (FeatIx(..))
+import qualified Data.CRF.Chain2.Generic.Inference as I
+import qualified Data.CRF.Chain2.Generic.Train as Train
+import qualified Data.CRF.Chain2.Generic.FeatMap as F
+import qualified Control.Monad.Codec as C
+import qualified Numeric.SGD as SGD
+import qualified NLP.Concraft.Disamb as D
+
+-- | Observation.
+newtype Ob = Ob { unOb :: Int } deriving (Show, Eq, Ord, Ix, Binary)
+
+-- | [Sub]label.
+newtype Lb = Lb { unLb :: Int } deriving (Show, Eq, Ord, Ix, Binary)
+
+-- | Feature.
+data Feat
+    = TFeat3
+        { x1    :: {-# UNPACK #-} !Lb
+        , x2    :: {-# UNPACK #-} !Lb
+        , x3    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    | TFeat2
+        { x1    :: {-# UNPACK #-} !Lb
+        , x2    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    | TFeat1
+        { x1    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    | OFeat
+        { ob    :: {-# UNPACK #-} !Ob
+        , x1    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    deriving (Show, Eq, Ord)
+
+instance Binary Feat where
+    put (OFeat o x k)       = putI 0 >> put o >> put x >> put k
+    put (TFeat3 x y z k)    = putI 1 >> put x >> put y >> put z >> put k
+    put (TFeat2 x y k)      = putI 2 >> put x >> put y >> put k
+    put (TFeat1 x k)        = putI 3 >> put x >> put k
+    get = getI >>= \i -> case i of
+        0   -> OFeat  <$> get <*> get <*> get
+        1   -> TFeat3 <$> get <*> get <*> get <*> get
+        2   -> TFeat2 <$> get <*> get <*> get
+        3   -> TFeat1 <$> get <*> get
+        _   -> error "get feature: unknown code"
+
+putI :: Int -> Put
+putI = put
+{-# INLINE putI #-}
+
+getI :: Get Int
+getI = get
+{-# INLINE getI #-}
+
+-- | Feature generation for complex [Lb] label type.
+featGen :: FeatGen Ob [Lb] Feat
+featGen = FeatGen
+    { obFeats   = obFeats'
+    , trFeats1  = trFeats1'
+    , trFeats2  = trFeats2'
+    , trFeats3  = trFeats3' }
+  where
+    obFeats' ob' xs =
+        [ OFeat ob' x k
+        | (x, k) <- zip xs [0..] ]
+    trFeats1' xs =
+        [ TFeat1 x k
+        | (x, k) <- zip xs [0..] ]
+    trFeats2' xs1 xs2 =
+        [ TFeat2 x1' x2' k
+        | (x1', x2', k) <-
+          zip3 xs1 xs2 [0..] ]
+    trFeats3' xs1 xs2 xs3 =
+        [ TFeat3 x1' x2' x3' k
+        | (x1', x2', x3', k) <-
+          zip4 xs1 xs2 xs3 [0..] ]
+
+-- | Codec internal data.  The first component is used to
+-- encode observations of type a, the second one is used to
+-- encode labels of type [b].
+type CodecData a b =
+    ( C.AtomCodec a
+    , V.Vector (C.AtomCodec (Maybe b)) )
+
+obLens :: Lens (a, b) a
+obLens = Lens $ \(a, b) -> store (\a' -> (a', b)) a
+
+lbLens :: Int -> Lens (a, V.Vector b) b
+lbLens k = Lens $ \(a, b) -> store
+    (\x -> (a, b V.// [(k, x)]))
+    (b V.! k)
+
+-- | Codec dependes on the number of layers. 
+codec :: (Ord a, Ord b) => Int -> Codec a [b] (CodecData a b) Ob [Lb]
+codec n = Codec
+    { empty =
+        let x = C.execCodec C.empty (C.encode C.idLens Nothing)
+        in  (C.empty, V.replicate n x)
+    , encodeObU = fmap Ob . C.encode' obLens
+    , encodeObN = fmap (fmap Ob) . C.maybeEncode obLens
+    , encodeLbU = \ xs -> sequence
+        [ Lb <$> C.encode (lbLens k) (Just x)
+        | (x, k) <- zip xs [0..] ]
+    , encodeLbN = \ xs ->
+        let encode lens x = C.maybeEncode lens (Just x) >>= \mx -> case mx of
+                Just x' -> return x'
+                Nothing -> fromJust <$> C.maybeEncode lens Nothing
+        in  sequence
+                [ Lb <$> encode (lbLens k) x
+                | (x, k) <- zip xs [0..] ]
+    , decodeLbC = \ xs -> sequence <$> sequence
+        [ C.decode (lbLens k) (unLb x)
+        | (x, k) <- zip xs [0..] ]
+    , hasLabel = \ cdcData xs -> and
+        [ M.member
+            (Just x)
+            (C.to $ snd cdcData V.! k)
+        | (x, k) <- zip xs [0..] ] }
+
+-- | Dummy feature index.
+dummy :: FeatIx
+dummy = FeatIx (-1)
+{-# INLINE dummy #-}
+
+-- | Transition map restricted to a particular tagging layer.
+type TransMap = A.UArray (Lb, Lb, Lb) FeatIx
+
+-- | CRF feature map.
+data FeatMap a = FeatMap
+    { transMaps	:: V.Vector TransMap
+    , otherMap 	:: M.Map Feat FeatIx }
+
+instance Binary (FeatMap Feat) where
+    put FeatMap{..} = put transMaps >> put otherMap
+    get = FeatMap <$> get <*> get
+
+instance F.FeatMap FeatMap Feat where
+    featIndex (TFeat3 x y z k) (FeatMap v _) = do
+        m  <- v V.!? k
+        ix <- m !? (x, y, z)
+        guard (ix /= dummy)
+        return ix
+    featIndex x (FeatMap _ m) = M.lookup x m
+    mkFeatMap xs = FeatMap
+        ( V.fromList
+            [ mkArray . catMaybes $
+                map (getTFeat3 k) xs
+            | k <- [0 .. maxLayerNum xs] ] )
+        (M.fromList (filter (isOther . fst) xs))
+      where
+        maxLayerNum = maximum . map (ln.fst)
+        getTFeat3 i (TFeat3 x y z j, v)
+            | i == j                = Just ((x, y, z), v)
+            | otherwise             = Nothing
+        getTFeat3 _ _               = Nothing
+        isOther (TFeat3 _ _ _ _)    = False
+        isOther _                   = True
+        mkArray ys =
+            let p = foldl1' updateMin (map fst ys)
+                q = foldl1' updateMax (map fst ys)
+                updateMin (!x, !y, !z) (x', y', z') =
+                    (min x x', min y y', min z z')
+                updateMax (!x, !y, !z) (x', y', z') =
+                    (max x x', max y y', max z z')
+                zeroed pq = A.array pq [(k, dummy) | k <- range pq]
+            in  zeroed (p, q) A.// ys
+
+(!?) :: (Ix i, A.IArray a b) => a i b -> i -> Maybe b
+m !? x = if inRange (A.bounds m) x
+    then Just (m A.! x)
+    else Nothing
+{-# INLINE (!?) #-}
+
+-- | CRF model data.
+data CRF a b = CRF
+    { numOfLayers   :: Int
+    , codecData     :: CodecData a b
+    , model         :: Model FeatMap Ob [Lb] Feat }
+
+instance (Ord a, Ord b, Binary a, Binary b) => Binary (CRF a b) where
+    put CRF{..} = put numOfLayers >> put codecData >> put (core model)
+    get = CRF <$> get <*> get <*> do
+        _core <- get
+        return $ withCore _core featGen
+
+-- | Codec specification given the number of layers.
+codecSpec
+    :: (Ord a, Ord b) => Int
+    -> Train.CodecSpec a [b] (CodecData a b) Ob [Lb]
+codecSpec n = Train.CodecSpec
+    { Train.mkCodec = mkCodec (codec n)
+    , Train.encode  = encodeDataL (codec n) }
+
+-- | Train the CRF using the stochastic gradient descent method.
+-- Use the provided feature selection function to determine model
+-- features.
+train
+    :: (Ord o, Ord t)
+    => Int                          -- ^ Number of tagging layers
+    -> FeatSel Ob [Lb] Feat         -- ^ Feature selection
+    -> SGD.SgdArgs                  -- ^ Args for SGD
+    -> D.TrainCRF o [t] (CRF o t)
+train n featSel sgdArgs trainIO evalIO'Maybe = do
+    (_codecData, _model) <- Train.train
+        sgdArgs
+        (codecSpec n)
+        featGen
+        featSel
+        trainIO
+        evalIO'Maybe
+    return $ CRF n _codecData _model
+
+-- | Find the most probable label sequence.
+tag :: (Ord o, Ord t) => CRF o t -> D.TagCRF o [t]
+tag CRF{..} sent
+    = onWords . decodeLabels cdc codecData
+    . I.tag model . encodeSent cdc codecData
+    $ sent
+  where
+    cdc = codec numOfLayers
+    onWords xs =
+        [ unJust cdc codecData word x
+        | (word, x) <- zip sent xs ]
diff --git a/NLP/Concraft/Format.hs b/NLP/Concraft/Format.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Format.hs
@@ -0,0 +1,44 @@
+-- | The module provides several abstractions for representing external
+-- data formats.  Concraft will be able to work with any format which
+-- implements those abstractions.
+
+module NLP.Concraft.Format
+( Tag
+, Word (..)
+, Sent (..)
+, Doc (..)
+) where
+
+import Prelude hiding (words, unwords)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as L
+import qualified NLP.Concraft.Morphosyntax as M
+
+-- | Textual representation of morphposyntactic tag.
+type Tag = T.Text
+
+-- | Words handler.
+data Word w = Word {
+    -- | Extract information relevant for tagging.
+      extract       :: w -> M.Word Tag
+    -- | Select the set of morphosyntactic interpretations.
+    , select        :: M.WMap Tag -> w -> w }
+
+-- | Sentence handler.
+data Sent s w = Sent {
+    -- | Split sentence into a list of words.
+      parseSent     :: s -> [w]
+    -- | Merge words with a sentence.
+    , mergeSent     :: [w] -> s -> s
+    -- | Words handler.
+    , wordHandler   :: Word w }
+
+-- | Document format.
+data Doc f s w = Doc {
+    -- | Parse textual interpretations into a functor with
+    -- sentence elements.
+      parseDoc      :: L.Text -> f s
+    -- | Show textual reprezentation of a document.
+    , showDoc       :: f s -> L.Text
+    -- | Sentence handler.
+    , sentHandler   :: Sent s w }
diff --git a/NLP/Concraft/Format/Plain.hs b/NLP/Concraft/Format/Plain.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Format/Plain.hs
@@ -0,0 +1,186 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Simple format for morphosyntax representation which
+-- assumes that all tags have a textual representation
+-- with no spaces inside and that one of the tags indicates
+-- unknown words.
+
+module NLP.Concraft.Format.Plain
+( plainFormat
+) where
+
+import Control.Arrow (first)
+import Data.Monoid (Monoid, mappend, mconcat)
+import Data.Maybe (catMaybes)
+import Data.List (groupBy)
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as L
+import qualified Data.Text.Lazy.Builder as L
+
+import qualified NLP.Concraft.Morphosyntax as Mx
+import qualified NLP.Concraft.Format as F
+
+-- | No space, space or newline.
+data Space
+    = None
+    | Space
+    | NewLine
+    deriving (Show, Eq, Ord)
+
+-- | A token.
+data Token = Token
+    { orth      :: T.Text
+    , space     :: Space
+    , known     :: Bool
+    -- | Interpretations of the token, each interpretation annotated
+    -- with a /disamb/ Boolean value (if 'True', the interpretation
+    -- is correct within the context).
+    , interps   :: M.Map Interp Bool }
+    deriving (Show, Eq, Ord)
+    
+data Interp = Interp
+    { base  :: Maybe T.Text
+    , tag   :: F.Tag }
+    deriving (Show, Eq, Ord)
+
+noneBase :: T.Text
+noneBase = "None"
+
+-- | Create document handler given value of the /ignore/ tag.
+plainFormat :: F.Tag -> F.Doc [] [Token] Token
+plainFormat ign = F.Doc (parsePlain ign) (showPlain ign) sentHandler
+
+-- | Sentence handler.
+sentHandler :: F.Sent [Token] Token
+sentHandler = F.Sent id (\xs _ -> xs) wordHandler
+
+-- | Word handler.
+wordHandler :: F.Word Token
+wordHandler = F.Word extract select
+
+-- | Extract information relevant for tagging.
+extract :: Token -> Mx.Word F.Tag
+extract tok = Mx.Word
+    { Mx.orth       = orth tok
+    , Mx.tagWMap    = Mx.mkWMap
+        [ (tag x, if disamb then 1 else 0)
+        | (x, disamb) <- M.toList (interps tok) ]
+    , Mx.oov        = not (known tok) }
+
+-- | Select interpretations.
+select :: Mx.WMap F.Tag -> Token -> Token
+select wMap tok =
+    tok { interps = newInterps }
+  where
+    wSet = M.fromList . map (first tag) . M.toList . interps
+    asDmb x = if x > 0
+        then True
+        else False
+    newInterps = M.fromList $
+        [ case M.lookup (tag interp) (Mx.unWMap wMap) of
+            Just x  -> (interp, asDmb x)
+            Nothing -> (interp, False)
+        | interp <- M.keys (interps tok) ]
+            ++ catMaybes
+        [ if tag `M.member` wSet tok
+            then Nothing
+            else Just (Interp Nothing tag, asDmb x)
+        | (tag, x) <- M.toList (Mx.unWMap wMap) ]
+
+parsePlain :: F.Tag -> L.Text -> [[Token]]
+parsePlain ign = map (parseSent ign) . init . L.splitOn "\n\n"
+
+parseSent :: F.Tag -> L.Text -> [Token]
+parseSent ign
+    = map (parseWord ignL)
+    . groupBy (\_ x -> cond x)
+    . L.lines
+  where
+    cond = ("\t" `L.isPrefixOf`)
+    ignL = L.fromStrict ign
+
+parseWord :: L.Text -> [L.Text] -> Token
+parseWord ign xs =
+    (Token _orth _space _known _interps)
+  where
+    (_orth, _space) = parseHeader (head xs)
+    ys          = map (parseInterp ign) (tail xs)
+    _known      = not (Nothing `elem` ys)
+    _interps    = M.fromListWith max (catMaybes ys)
+
+parseInterp :: L.Text -> L.Text -> Maybe (Interp, Bool)
+parseInterp ign =
+    doIt . tail . L.splitOn "\t"
+  where
+    doIt [form, tag]
+        | tag == ign    = Nothing
+        | otherwise     = Just $
+            (mkInterp form tag, False)
+    doIt [form, tag, "disamb"] = Just $
+        (mkInterp form tag, True)
+    doIt xs = error $ "parseInterp: " ++ show xs
+    mkInterp form tag
+        | formS == noneBase = Interp Nothing tagS
+        | otherwise         = Interp (Just formS) tagS
+      where
+        formS   = L.toStrict form
+        tagS    = L.toStrict tag
+
+parseHeader :: L.Text -> (T.Text, Space)
+parseHeader xs =
+    let [_orth, space] = L.splitOn "\t" xs
+    in  (L.toStrict _orth, parseSpace space)
+
+parseSpace :: L.Text -> Space
+parseSpace "none"    = None
+parseSpace "space"   = Space
+parseSpace "newline" = NewLine
+parseSpace "newlines" = NewLine -- TODO: Remove this temporary fix
+parseSpace xs        = error ("parseSpace: " ++ L.unpack xs)
+
+-- | Printing.
+
+-- | An infix synonym for 'mappend'.
+(<>) :: Monoid m => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}
+
+showPlain :: F.Tag -> [[Token]] -> L.Text
+showPlain ign =
+    L.toLazyText . mconcat  . map (\xs -> buildSent ign xs <> "\n")
+
+buildSent :: F.Tag -> [Token] -> L.Builder
+buildSent ign = mconcat . map (buildWord ign)
+
+buildWord :: F.Tag -> Token -> L.Builder
+buildWord ign tok
+    =  L.fromText (orth tok) <> "\t"
+    <> buildSpace (space tok) <> "\n"
+    <> buildKnown ign (known tok)
+    <> buildInterps (M.toList $ interps tok)
+
+buildInterps :: [(Interp, Bool)] -> L.Builder
+buildInterps interps = mconcat
+    [ "\t" <> buildBase interp <>
+      "\t" <> buildTag  interp <>
+      if dmb
+        then "\tdisamb\n"
+        else "\n"
+    | (interp, dmb) <- interps ]
+  where
+    buildTag    = L.fromText . tag
+    buildBase x = case base x of
+        Just b  -> L.fromText b
+        Nothing -> L.fromText noneBase
+
+buildSpace :: Space -> L.Builder
+buildSpace None     = "none"
+buildSpace Space    = "space"
+buildSpace NewLine  = "newline"
+
+buildKnown :: F.Tag -> Bool -> L.Builder
+buildKnown _   True     = ""
+buildKnown ign False    =  "\t" <> L.fromText noneBase
+                        <> "\t" <> L.fromText ign <> "\n"
diff --git a/NLP/Concraft/Guess.hs b/NLP/Concraft/Guess.hs
--- a/NLP/Concraft/Guess.hs
+++ b/NLP/Concraft/Guess.hs
@@ -1,131 +1,134 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module NLP.Concraft.Guess
-( Ox
-, Schema
-, Ob
-, schema
-, schematize
-, Guesser (..)
+( Guesser (..)
 , guess
-, tagFile
-, learn
+, include
+, guessSent
+, guessDoc
+, trainOn
 ) where
 
-import Control.Applicative (pure, (<$>), (<*>))
+import Prelude hiding (words)
+import Control.Applicative ((<$>))
+import Data.Binary (Binary)
+import Data.Foldable (Foldable, foldMap)
+import Data.Text.Binary ()
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.Text as T
 import qualified Data.Text.Lazy as L
+import qualified Data.Text.Lazy.IO as L
 import qualified Data.Vector as V
 
-import Data.Binary (Binary, get, put)
-import Data.Text.Binary ()
-
 import qualified Control.Monad.Ox as Ox
-import qualified Control.Monad.Ox.Text as Ox
 import qualified Data.CRF.Chain1.Constrained as CRF
 import qualified Numeric.SGD as SGD
 
-import NLP.Concraft.Morphosyntax
-import qualified NLP.Concraft.Plain as P
-
--- | The Ox monad specialized to word token type and text observations.
--- TODO: Move to monad-ox package from here and from the nerf library.
-type Ox t a = Ox.Ox (Word t) T.Text a
-
--- | A schema is a block of the Ox computation performed within the
--- context of the sentence and the absolute sentence position.
-type Schema t a = V.Vector (Word t) -> Int -> Ox t a
-
--- | An observation consist of an index (of list type) and an actual
--- observation value.
-type Ob = ([Int], T.Text)
-
-schema :: Schema t ()
-schema sent = \k -> do
-    mapM_ (Ox.save . lowPref k) [1, 2]
-    mapM_ (Ox.save . lowSuff k) [1, 2]
-    Ox.save (knownAt k)
-    Ox.save (isBeg k <> pure "-" <> shapeP k)
-  where
-    at          = Ox.atWith sent
-    lowOrth i   = T.toLower <$> orth `at` i
-    lowPref i j = Ox.prefix j =<< lowOrth i
-    lowSuff i j = Ox.suffix j =<< lowOrth i
-    shape i     = Ox.shape <$> orth `at` i
-    shapeP i    = Ox.pack <$> shape i
-    knownAt i   = boolF <$> known `at` i
-    isBeg i     = (Just . boolF) (i == 0)
-    boolF True  = "T"
-    boolF False = "F"
-    x <> y      = T.append <$> x <*> y
+import NLP.Concraft.Schema
+import qualified NLP.Concraft.Morphosyntax as Mx
+import qualified NLP.Concraft.Format as F
 
 -- | Schematize the input sentence with according to 'schema' rules.
-schematize :: Ord t => Sent t -> CRF.Sent Ob t
-schematize sent =
+schematize :: Ord t => Schema t a -> Mx.Sent t -> CRF.Sent Ob t
+schematize schema sent =
     [ CRF.Word (obs i) (lbs i)
     | i <- [0 .. n - 1] ]
   where
     v = V.fromList sent
     n = V.length v
     obs = S.fromList . Ox.execOx . schema v
-    lbs = tags . (v V.!)
+    lbs i 
+        | Mx.oov w  = S.empty
+        | otherwise = Mx.interpsSet w
+        where w = v V.! i
 
 -- | A guesser represented by the conditional random field.
-data Guesser t = Guesser
-    { crf   :: CRF.CRF Ob t -- ^ The CRF model
-    , ign   :: t            -- ^ The tag indicating unkown words
-    }
+newtype Guesser t = Guesser { crf :: CRF.CRF Ob t }
+    deriving (Binary)
 
-instance (Ord t, Binary t) => Binary (Guesser t) where
-    put Guesser{..} = put crf >> put ign
-    get = Guesser <$> get <*> get
+-- | Determine the 'k' most probable labels for each word in the sentence.
+guess :: Ord t => Int -> Schema t a -> Guesser t -> Mx.Sent t -> [[t]]
+guess k schema gsr sent = CRF.tagK k (crf gsr) (schematize schema sent)
 
--- | Determine the 'k' most probable labels for each unknown word
--- in the sentence.
-guess :: Ord t => Int -> Guesser t -> Sent t -> [[t]]
-guess k gsr sent = CRF.tagK k (crf gsr) (schematize sent)
-{-# INLINE guess #-}
+-- | Include guessing results into weighted tag maps
+-- assigned to individual words.
+includeWMaps :: Ord t => Mx.Sent t -> [[t]] -> [Mx.WMap t]
+includeWMaps words guessed =
+    [ if Mx.oov word
+        then addInterps (Mx.tagWMap word) xs
+        else Mx.tagWMap word
+    | (xs, word) <- zip guessed words ]
+  where
+    -- Add new interpretations.
+    addInterps wm xs = Mx.mkWMap
+        $  M.toList (Mx.unWMap wm)
+        ++ zip xs [0, 0 ..]
 
--- | Tag the file.
-tagFile
-    :: Int              -- ^ Guesser argument
-    -> Guesser T.Text   -- ^ Guesser itself
-    -> FilePath         -- ^ File to tag (plain format)
-    -> IO L.Text
-tagFile k gsr path =
-    P.showPlain (ign gsr) . map onSent <$> P.readPlain (ign gsr) path
+-- | Include guessing results into the sentence.
+include :: Ord t => Mx.Sent t -> [[t]] -> Mx.Sent t
+include words guessed =
+    [ word { Mx.tagWMap = wMap }
+    | (word, wMap) <- zip words wMaps ]
   where
-    onSent sent =
-        let (xs, _) = unzip (map P.fromTok sent)
-            yss = guess k gsr xs
-        in  [ if P.known tok
-                then tok
-                else P.addNones False tok ys
-            | (tok, ys) <- zip sent yss ]
+    wMaps = includeWMaps words guessed
 
--- | TODO: Abstract over the format type.
-learn
-    :: SGD.SgdArgs      -- ^ SGD parameters 
-    -> T.Text        	-- ^ The tag indicating unknown words
-    -> FilePath         -- ^ Train file (plain format)
+-- | Tag sentence in external format.  Selected interpretations
+-- (tags correct within the context) will be preserved.
+guessSent :: F.Sent s w -> Int -> Schema F.Tag a -> Guesser F.Tag -> s -> s
+guessSent F.Sent{..} k schema gsr sent = flip mergeSent sent
+    [ select wMap word
+    | (wMap, word) <- zip wMaps (parseSent sent) ]
+  where
+    -- Extract word handler.
+    F.Word{..} = wordHandler
+    -- Word in internal format.
+    words   = map extract (parseSent sent)
+    -- Guessed lists of interpretations for individual words.
+    guessed = guess k schema gsr words
+    -- Resultant weighted maps. 
+    wMaps   = includeWMaps words guessed
+
+-- | Tag file.
+guessDoc
+    :: Functor f
+    => F.Doc f s w  	-- ^ Document format handler
+    -> Int              -- ^ Guesser argument
+    -> Schema F.Tag a	-- ^ Observation schema
+    -> Guesser F.Tag    -- ^ Guesser itself
+    -> L.Text           -- ^ Input
+    -> L.Text           -- ^ Output
+guessDoc F.Doc{..} k schema gsr
+    = showDoc 
+    . fmap (guessSent sentHandler k schema gsr)
+    . parseDoc
+
+-- | Train guesser.
+trainOn
+    :: Foldable f
+    => F.Doc f s w      -- ^ Document format handler
+    -> Schema F.Tag a	-- ^ Observation schema
+    -> SGD.SgdArgs      -- ^ SGD parameters 
+    -> FilePath         -- ^ Training file
     -> Maybe FilePath   -- ^ Maybe eval file
-    -> IO (Guesser T.Text)
-learn sgdArgs _ign trainPath evalPath'Maybe = do
+    -> IO (Guesser F.Tag)
+trainOn format schema sgdArgs trainPath evalPath'Maybe = do
     _crf <- CRF.train sgdArgs
-        (schemed _ign trainPath)
-        (schemed _ign <$> evalPath'Maybe)
+        (schemed format schema trainPath)
+        (schemed format schema <$> evalPath'Maybe)
         (const CRF.presentFeats)
-    return $ Guesser _crf _ign
+    return $ Guesser _crf
 
 -- | Schematized data from the plain file.
-schemed :: T.Text -> FilePath -> IO [CRF.SentL Ob T.Text]
-schemed _ign =
-    fmap (map onSent) . P.readPlain _ign
+schemed
+    :: Foldable f => F.Doc f s w -> Schema F.Tag a
+    -> FilePath -> IO [CRF.SentL Ob F.Tag]
+schemed F.Doc{..} schema path =
+    foldMap onSent . parseDoc <$> L.readFile path
   where
+    F.Sent{..} = sentHandler
+    F.Word{..} = wordHandler
     onSent sent =
-        let (xs, ys) = unzip (map P.fromTok sent)
-            mkDist = CRF.mkDist . M.toList . M.map unPositive
-        in  zip (schematize xs) (map mkDist ys)
+        let xs = map extract (parseSent sent)
+            mkProb = CRF.mkProb . M.toList . Mx.unWMap . Mx.tagWMap
+        in  [zip (schematize schema xs) (map mkProb xs)]
diff --git a/NLP/Concraft/Morphosyntax.hs b/NLP/Concraft/Morphosyntax.hs
--- a/NLP/Concraft/Morphosyntax.hs
+++ b/NLP/Concraft/Morphosyntax.hs
@@ -1,70 +1,68 @@
 {-# LANGUAGE RecordWildCards #-}
 
+-- | Types and functions related to the morphosyntax data layer.
+
 module NLP.Concraft.Morphosyntax
-( Word (..)
+( 
+-- * Morphosyntax data
+  Sent
+, Word (..)
 , mapWord
-, Sent
-, Choice
-, mapChoice
-, Positive (unPositive)
-, (<+>)
-, mkPositive
-, best
-, known
+, mapSent
+, interpsSet
+, interps
+-- * Weighted collection
+, WMap (unWMap)
+, mkWMap
+, mapWMap
 ) where
 
 import Control.Arrow (first)
-import Data.Ord (comparing)
-import Data.List (maximumBy)
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.Text as T
 
--- | A word parametrized over the tag type.
+
+-- | A sentence of 'Word's.
+type Sent t = [Word t]
+
+-- | A word parametrized over a tag type.
 data Word t = Word {
     -- | Orthographic form.
-      orth  :: T.Text
-    -- | Set of word interpretations.
-    , tags  :: S.Set t }
-    deriving (Show, Read, Eq, Ord)
+      orth      :: T.Text
+    -- | Set of word interpretations.  To each interpretation
+    -- a "weight of correctness within the context" is assigned.
+    , tagWMap   :: WMap t
+    -- | Out-of-vocabulary (OOV) word, i.e. word unknown to the
+    -- morphosyntactic analyser.
+    , oov       :: Bool }
+    deriving (Show, Eq, Ord)
 
+-- | Map function over word tags.
 mapWord :: Ord b => (a -> b) -> Word a -> Word b
-mapWord f Word{..} = Word
-    { orth = orth
-    , tags = S.fromList . map f . S.toList $ tags }
+mapWord f w = w { tagWMap = mapWMap f (tagWMap w) }
 
--- | A sentence of 'Word's.
-type Sent t = [Word t]
+-- | Map function over sentence tags.
+mapSent :: Ord b => (a -> b) -> Sent a -> Sent b
+mapSent = map . mapWord
 
--- | Interpretations chosen in the given context with
--- corresponding positive weights.
-type Choice t = M.Map t (Positive Double)
+-- | Interpretations of the word.
+interpsSet :: Word t -> S.Set t
+interpsSet = M.keysSet . unWMap . tagWMap
 
--- | Positive number.
-newtype Positive a = Positive { unPositive :: a }
-    deriving (Show, Eq, Ord)
+-- | Interpretations of the word.
+interps :: Word t -> [t]
+interps = S.toList . interpsSet
 
-(<+>) :: Num a => Positive a -> Positive a -> Positive a
-Positive x <+> Positive y = Positive (x + y)
-{-# INLINE (<+>) #-}
 
-mapChoice :: Ord b => (a -> b) -> Choice a -> Choice b
-mapChoice f = M.fromListWith (<+>) . map (first f) . M.toList
-
-mkPositive :: (Num a, Ord a) => a -> Positive a
-mkPositive x
-    | x > 0     = Positive x
-    | otherwise = error "mkPositive: not a positive number"
-{-# INLINE mkPositive #-}
+-- | A weighted collection of type @a@ elements.
+newtype WMap a = WMap { unWMap :: M.Map a Double }
+    deriving (Show, Eq, Ord)
 
--- | Retrieve the most probable interpretation.
-best :: Choice t -> t
-best c
-    | M.null c  = error "best: null choice" 
-    | otherwise = fst . maximumBy (comparing snd) $ M.toList c
+-- | Make a weighted collection.
+mkWMap :: Ord a => [(a, Double)] -> WMap a
+mkWMap = WMap . M.fromListWith (+) . filter ((>=0).snd)
 
--- | A word is considered to be known when the set of possible
--- interpretations is not empty.
-known :: Word t -> Bool
-known = not . S.null . tags
-{-# INLINE known #-}
+-- | Map function over weighted collection elements. 
+mapWMap :: Ord b => (a -> b) -> WMap a -> WMap b
+mapWMap f = mkWMap . map (first f) . M.toList . unWMap
diff --git a/NLP/Concraft/Plain.hs b/NLP/Concraft/Plain.hs
deleted file mode 100644
--- a/NLP/Concraft/Plain.hs
+++ /dev/null
@@ -1,196 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- | Simple format for morphosyntax representation which
--- assumes that all tags have a textual representation
--- with no spaces inside and that one of the tags indicates
--- unknown words.
-
-module NLP.Concraft.Plain
-(
--- * Types
-  Space (..)
-, Token (..)
-, Interp (..)
-
--- * Interface
-, fromTok
-, choose
-, addInterps
-, addNones
-
--- * Parsing
-, readPlain
-, parsePlain
-, parseSent
-
--- * Showing
-, writePlain
-, showPlain
-, showSent
-, showWord
-) where
-
-import Data.Monoid (Monoid, mappend, mconcat)
-import Data.Maybe (catMaybes)
-import Data.List (groupBy)
-import qualified Data.Set as S
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.IO as L
-import qualified Data.Text.Lazy.Builder as L
-
-import qualified NLP.Concraft.Morphosyntax as Mx
-
--- | No space, space or newline.
-data Space
-    = None
-    | Space
-    | NewLine
-    deriving (Show, Eq, Ord)
-
--- | A token.
-data Token = Token
-    { orth      :: T.Text
-    , space     :: Space
-    , known     :: Bool
-    -- | Interpretations with disambiguation info.
-    , interps   :: M.Map Interp Bool }
-    deriving (Show, Eq, Ord)
-    
-data Interp = Interp
-    { base      :: T.Text
-    , tag       :: T.Text }
-    deriving (Show, Eq, Ord)
-
--- | Extract information relevant for tagging.
-fromTok :: Token -> (Mx.Word T.Text, Mx.Choice T.Text)
-fromTok tok =
-    (word, choice)
-  where
-    word = Mx.Word
-        { Mx.orth   = orth tok
-        , Mx.tags   = if known tok
-            then S.fromList . map tag . M.keys $ interps tok
-            else S.empty }
-    choice = M.fromListWith (Mx.<+>)
-        [ (tag x, Mx.mkPositive 1)
-        | (x, True) <- M.toList (interps tok) ]
-
--- | Mark all interpretations with tag component beeing a member of
--- the given choice set with disamb annotations.
-choose :: Token -> S.Set T.Text -> Token
-choose tok choice =
-    tok { interps = (M.fromList . map mark . M.keys) (interps tok) }
-  where
-    mark ip 
-        | tag ip `S.member` choice  = (ip, True) 
-        | otherwise                 = (ip, False)
-
--- | Add new interpretations with given disamb annotation.
-addInterps :: Bool -> Token -> [Interp] -> Token
-addInterps dmb tok xs =
-    let newIps = M.fromList [(x, dmb) | x <- xs]
-    in  tok { interps = M.unionWith max newIps (interps tok) }
-
--- | Add new interpretations with "None" base and given disamb annotation.
-addNones :: Bool -> Token -> [T.Text] -> Token
-addNones dmb tok = addInterps dmb tok . map (Interp "None")
-
-readPlain :: T.Text -> FilePath -> IO [[Token]]
-readPlain ign = fmap (parsePlain ign) . L.readFile
-
-parsePlain :: T.Text -> L.Text -> [[Token]]
-parsePlain ign = map (parseSent ign) . init . L.splitOn "\n\n"
-
-parseSent :: T.Text -> L.Text -> [Token]
-parseSent ign
-    = map (parseWord ignL)
-    . groupBy (\_ x -> cond x)
-    . L.lines
-  where
-    cond = ("\t" `L.isPrefixOf`)
-    ignL = L.fromStrict ign
-
-parseWord :: L.Text -> [L.Text] -> Token
-parseWord ign xs =
-    (Token _orth _space _known _interps)
-  where
-    (_orth, _space) = parseHeader (head xs)
-    ys          = map (parseInterp ign) (tail xs)
-    _known      = not (Nothing `elem` ys)
-    _interps    = M.fromList (catMaybes ys)
-
-parseInterp :: L.Text -> L.Text -> Maybe (Interp, Bool)
-parseInterp ign =
-    doIt . tail . L.splitOn "\t"
-  where
-    doIt [form, tag]
-        | tag == ign    = Nothing
-        | otherwise     = Just $
-            (mkInterp form tag, False)
-    doIt [form, tag, "disamb"] = Just $
-        (mkInterp form tag, True)
-    doIt xs = error $ "parseInterp: " ++ show xs
-    mkInterp form tag = Interp (L.toStrict form) (L.toStrict tag)
-
-parseHeader :: L.Text -> (T.Text, Space)
-parseHeader xs =
-    let [_orth, space] = L.splitOn "\t" xs
-    in  (L.toStrict _orth, parseSpace space)
-
-parseSpace :: L.Text -> Space
-parseSpace "none"    = None
-parseSpace "space"   = Space
-parseSpace "newline" = NewLine
-parseSpace "newlines" = NewLine -- TODO: Remove this temporary fix
-parseSpace xs        = error ("parseSpace: " ++ L.unpack xs)
-
--- | Printing.
-
--- | An infix synonym for 'mappend'.
-(<>) :: Monoid m => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}
-
-writePlain :: T.Text -> FilePath -> [[Token]] -> IO ()
-writePlain ign path = L.writeFile path . showPlain ign 
-
-showPlain :: T.Text -> [[Token]] -> L.Text
-showPlain ign =
-    L.toLazyText . mconcat  . map (\xs -> buildSent ign xs <> "\n")
-
-showSent :: T.Text -> [Token] -> L.Text
-showSent ign = L.toLazyText . buildSent ign
-
-showWord :: T.Text -> Token -> L.Text
-showWord ign = L.toLazyText . buildWord ign
-
-buildSent :: T.Text -> [Token] -> L.Builder
-buildSent ign = mconcat . map (buildWord ign)
-
-buildWord :: T.Text -> Token -> L.Builder
-buildWord ign tok
-    =  L.fromText (orth tok) <> "\t"
-    <> buildSpace (space tok) <> "\n"
-    <> buildKnown ign (known tok)
-    <> buildInterps (M.toList $ interps tok)
-
-buildInterps :: [(Interp, Bool)] -> L.Builder
-buildInterps interps = mconcat
-    [ "\t" <> L.fromText _base <>
-      "\t" <> L.fromText _tag <>
-      if dmb
-        then "\tdisamb\n"
-        else "\n"
-    | (Interp _base _tag, dmb) <- interps ]
-
-buildSpace :: Space -> L.Builder
-buildSpace None     = "none"
-buildSpace Space    = "space"
-buildSpace NewLine  = "newline"
-
-buildKnown :: T.Text -> Bool -> L.Builder
-buildKnown _ True       = ""
-buildKnown ign False    = "\tNone\t" <> L.fromText ign <> "\n"
diff --git a/NLP/Concraft/Schema.hs b/NLP/Concraft/Schema.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Schema.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module NLP.Concraft.Schema
+( Schema
+, Ox
+, Ob
+, guessSchemaDefault
+, disambSchemaDefault
+) where
+
+import Control.Applicative ((<$>), (<*>), pure)
+import qualified Data.Vector as V
+import qualified Data.Text as T
+import qualified Control.Monad.Ox as Ox
+import qualified Control.Monad.Ox.Text as Ox
+
+import qualified NLP.Concraft.Morphosyntax as Mx
+
+-- | The Ox monad specialized to word token type and text observations.
+type Ox t a = Ox.Ox (Mx.Word t) T.Text a
+
+-- | A schema is a block of the Ox computation performed within the
+-- context of the sentence and the absolute sentence position.
+type Schema t a = V.Vector (Mx.Word t) -> Int -> Ox t a
+
+-- | An observation consist of an index (of list type) and an actual
+-- observation value.
+type Ob = ([Int], T.Text)
+
+-- | Default guessing schema.
+guessSchemaDefault :: Schema t ()
+guessSchemaDefault sent = \k -> do
+    mapM_ (Ox.save . lowPref k) [1, 2]
+    mapM_ (Ox.save . lowSuff k) [1, 2]
+    Ox.save (knownAt k)
+    Ox.save (isBeg k <> pure "-" <> shapeP k)
+  where
+    at          = Ox.atWith sent
+    lowOrth i   = T.toLower <$> Mx.orth `at` i
+    lowPref i j = Ox.prefix j =<< lowOrth i
+    lowSuff i j = Ox.suffix j =<< lowOrth i
+    shape i     = Ox.shape <$> Mx.orth `at` i
+    shapeP i    = Ox.pack <$> shape i
+    knownAt i   = boolF <$> (not . Mx.oov) `at` i
+    isBeg i     = (Just . boolF) (i == 0)
+    boolF True  = "T"
+    boolF False = "F"
+    x <> y      = T.append <$> x <*> y
+
+-- | Default disambiguation schema.
+disambSchemaDefault :: Schema t ()
+disambSchemaDefault sent = \k -> do
+    mapM_ (Ox.save . lowOrth) [k - 1, k, k + 1]
+    _ <- Ox.whenJT (Mx.oov `at` k) $ do
+        mapM_ (Ox.save . lowPref k) [1, 2, 3]
+        mapM_ (Ox.save . lowSuff k) [1, 2, 3]
+        Ox.save (isBeg k <> pure "-" <> shapeP k)
+    return ()
+  where
+    at          = Ox.atWith sent
+    lowOrth i   = T.toLower <$> Mx.orth `at` i
+    lowPref i j = Ox.prefix j =<< lowOrth i
+    lowSuff i j = Ox.suffix j =<< lowOrth i
+    shape i     = Ox.shape <$> Mx.orth `at` i
+    shapeP i    = Ox.pack <$> shape i
+    isBeg i     = (Just . boolF) (i == 0)
+    boolF True  = "T"
+    boolF False = "F"
+    x <> y      = T.append <$> x <*> y
diff --git a/concraft.cabal b/concraft.cabal
--- a/concraft.cabal
+++ b/concraft.cabal
@@ -1,5 +1,5 @@
 name:               concraft
-version:            0.2.0
+version:            0.3.0
 synopsis:           Morphosyntactic tagging tool based on constrained CRFs
 description:
     A morphosyntactic tagging tool based on constrained conditional
@@ -12,45 +12,63 @@
 maintainer:         waszczuk.kuba@gmail.com
 stability:          experimental
 category:           Natural Language Processing
-homepage:           https://github.com/kawu/concraft
+homepage:           http://zil.ipipan.waw.pl/Concraft
 build-type:         Simple
 
 library
     build-depends:
         base >= 4 && < 5
+      , array
       , containers
       , binary
       , text
       , text-binary >= 0.1 && < 0.2
       , vector
-      , crf-chain1-constrained >= 0.1.1 && < 0.2
+      , vector-binary
+      , crf-chain1-constrained >= 0.1.2 && < 0.2
       , monad-ox >= 0.2 && < 0.3
       , sgd >= 0.2.2 && < 0.3
       , tagset-positional >= 0.2 && < 0.3
-      , crf-chain2-generic >= 0.1.1 && < 0.2
+      , crf-chain2-generic >= 0.3 && < 0.4
+      , monad-codec >= 0.2 && < 0.3
+      , data-lens
+      , comonad-transformers
+      , temporary
 
     exposed-modules:
-        NLP.Concraft.Morphosyntax
-      , NLP.Concraft.Plain
+        NLP.Concraft
+      , NLP.Concraft.Morphosyntax
+      , NLP.Concraft.Format
+      , NLP.Concraft.Format.Plain
+      , NLP.Concraft.Schema
       , NLP.Concraft.Guess
       , NLP.Concraft.Disamb
+      , NLP.Concraft.Disamb.Tiered
+      , NLP.Concraft.Disamb.Positional
 
     ghc-options: -Wall -O2
 
 source-repository head
     type: git
-    location: git://github.com/kawu/concraft.git
+    location: https://github.com/kawu/concraft.git
 
-executable concraft-guess
-    build-depends:
-        cmdargs
-    hs-source-dirs: ., tools
-    main-is: concraft-guess.hs    
-    ghc-options: -Wall -O2 -threaded
+-- executable concraft-guess
+--     build-depends:
+--         cmdargs
+--     hs-source-dirs: ., tools
+--     main-is: concraft-guess.hs    
+--     ghc-options: -Wall -O2 -threaded -rtsopts
+-- 
+-- executable concraft-disamb
+--     build-depends:
+--         cmdargs
+--     hs-source-dirs: ., tools
+--     main-is: concraft-disamb.hs    
+--     ghc-options: -Wall -O2 -threaded -rtsopts
 
-executable concraft-disamb
+executable concraft
     build-depends:
         cmdargs
     hs-source-dirs: ., tools
-    main-is: concraft-disamb.hs    
-    ghc-options: -Wall -O2 -threaded
+    main-is: concraft.hs    
+    ghc-options: -Wall -O2 -threaded -rtsopts
diff --git a/tools/concraft-disamb.hs b/tools/concraft-disamb.hs
deleted file mode 100644
--- a/tools/concraft-disamb.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-
-import Control.Monad (when)
-import System.Console.CmdArgs
-import Data.Binary (encodeFile, decodeFile)
-import Data.Text.Binary ()
-import qualified Data.Set as S
-import qualified Numeric.SGD as SGD
-import qualified Data.Text as T
-import qualified Data.Text.Lazy.IO as L
-
-import NLP.Concraft.Disamb
-
-tierConf :: TierConf
-tierConf =
-    (tier1, tier2)
-  where
-    tier1 = Tier True $ S.fromList ["cas", "per"]
-    tier2 = Tier False $ S.fromList
-        [ "nmb", "gnd", "deg", "asp" , "ngt", "acm"
-        , "acn", "ppr", "agg", "vlc", "dot" ]
-
-data Args
-  = LearnMode
-    { learnPath	    :: FilePath
-    , evalPath      :: Maybe FilePath
-    , tagsetPath    :: FilePath
-    , ignTag        :: String
-    , iterNum       :: Double
-    , batchSize     :: Int
-    , regVar        :: Double
-    , gain0         :: Double
-    , tau           :: Double
-    , outDisamb     :: FilePath }
-  | TagMode
-    { dataPath      :: FilePath
-    , ignTag        :: String
-    , inDisamb      :: FilePath }
-  deriving (Data, Typeable, Show)
-
-learnMode :: Args
-learnMode = LearnMode
-    { tagsetPath = def &= argPos 0 &= typ "TAGSET-PATH"
-    , ignTag = def &= argPos 1 &= typ "IGN-TAG"
-    , learnPath = def &= argPos 2 &= typ "TRAIN-FILE"
-    , evalPath = def &= typFile &= help "Evaluation file"
-    , iterNum = 10 &= help "Number of SGD iterations"
-    , batchSize = 30 &= help "Batch size"
-    , regVar = 10.0 &= help "Regularization variance"
-    , gain0 = 1.0 &= help "Initial gain parameter"
-    , tau = 5.0 &= help "Initial tau parameter"
-    , outDisamb = def &= typFile &= help "Output Disamb file" }
-
-tagMode :: Args
-tagMode = TagMode
-    { ignTag = def &= argPos 0 &= typ "IGN-TAG"
-    , inDisamb = def &= argPos 1 &= typ "DISAMB-FILE"
-    , dataPath = def &= argPos 2 &= typ "INPUT" }
-
-argModes :: Mode (CmdArgs Args)
-argModes = cmdArgsMode $ modes [learnMode, tagMode]
-
-main :: IO ()
-main = exec =<< cmdArgsRun argModes
-
-exec :: Args -> IO ()
-
-exec LearnMode{..} = do
-    dmb <- learn sgdArgs tagsetPath (T.pack ignTag) tierConf learnPath evalPath
-    when (not . null $ outDisamb) $ do
-        putStrLn $ "\nSaving model in " ++ outDisamb ++ "..."
-        encodeFile outDisamb dmb
-  where
-    sgdArgs = SGD.SgdArgs
-        { SGD.batchSize = batchSize
-        , SGD.regVar = regVar
-        , SGD.iterNum = iterNum
-        , SGD.gain0 = gain0
-        , SGD.tau = tau }
-
-exec TagMode{..} = do
-    dmb <- decodeFile inDisamb
-    L.putStr =<< tagFile (T.pack ignTag) dmb dataPath
diff --git a/tools/concraft-guess.hs b/tools/concraft-guess.hs
deleted file mode 100644
--- a/tools/concraft-guess.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
-
-import Control.Monad (when)
-import System.Console.CmdArgs
-import Data.Binary (encodeFile, decodeFile)
-import Data.Text.Binary ()
-import qualified Numeric.SGD as SGD
-import qualified Data.Text as T
-import qualified Data.Text.Lazy.IO as L
-
-import NLP.Concraft.Guess (learn, tagFile)
-
-data Args
-  = LearnMode
-    { learnPath	    :: FilePath
-    , evalPath      :: Maybe FilePath
-    , ignTag        :: String
-    , iterNum       :: Double
-    , batchSize     :: Int
-    , regVar        :: Double
-    , gain0         :: Double
-    , tau           :: Double
-    , outGuesser    :: FilePath }
-  | TagMode
-    { dataPath      :: FilePath
-    , inGuesser     :: FilePath
-    , guessNum      :: Int }
-  deriving (Data, Typeable, Show)
-
-learnMode :: Args
-learnMode = LearnMode
-    { ignTag = def &= argPos 0 &= typ "IGN-TAG"
-    , learnPath = def &= argPos 1 &= typ "TRAIN-FILE"
-    , evalPath = def &= typFile &= help "Evaluation file"
-    , iterNum = 10 &= help "Number of SGD iterations"
-    , batchSize = 30 &= help "Batch size"
-    , regVar = 10.0 &= help "Regularization variance"
-    , gain0 = 1.0 &= help "Initial gain parameter"
-    , tau = 5.0 &= help "Initial tau parameter"
-    , outGuesser = def &= typFile &= help "Output Guesser file" }
-
-tagMode :: Args
-tagMode = TagMode
-    { inGuesser = def &= argPos 0 &= typ "GUESSER-FILE"
-    , dataPath = def &= argPos 1 &= typ "INPUT"
-    , guessNum = 10 &= help "Number of guessed tags for each unknown word" }
-
-argModes :: Mode (CmdArgs Args)
-argModes = cmdArgsMode $ modes [learnMode, tagMode]
-
-main :: IO ()
-main = exec =<< cmdArgsRun argModes
-
-exec :: Args -> IO ()
-
-exec LearnMode{..} = do
-    gsr <- learn sgdArgs (T.pack ignTag) learnPath evalPath
-    when (not . null $ outGuesser) $ do
-        putStrLn $ "\nSaving model in " ++ outGuesser ++ "..."
-        encodeFile outGuesser gsr
-  where
-    sgdArgs = SGD.SgdArgs
-        { SGD.batchSize = batchSize
-        , SGD.regVar = regVar
-        , SGD.iterNum = iterNum
-        , SGD.gain0 = gain0
-        , SGD.tau = tau }
-
-exec TagMode{..} = do
-    gsr <- decodeFile inGuesser
-    L.putStr =<< tagFile guessNum gsr dataPath
diff --git a/tools/concraft.hs b/tools/concraft.hs
new file mode 100644
--- /dev/null
+++ b/tools/concraft.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (when)
+import System.Console.CmdArgs
+import Data.Binary (Binary, put, get, encodeFile, decodeFile)
+import Data.Text.Binary ()
+import qualified Numeric.SGD as SGD
+import qualified Data.Text as T
+import qualified Data.Text.Lazy.IO as L
+import qualified Data.Tagset.Positional as P
+
+import NLP.Concraft.Format.Plain (plainFormat)
+import qualified NLP.Concraft as C
+import qualified NLP.Concraft.Schema as S
+import qualified NLP.Concraft.Format as F
+import qualified NLP.Concraft.Guess as G
+import qualified NLP.Concraft.Disamb.Positional as D
+import qualified NLP.Concraft.Disamb.Tiered as R
+
+-- | Data formats. 
+data Format = Plain deriving (Data, Typeable, Show)
+
+-- | Concraft data.
+data ConcraftData = ConcraftData
+    { guesser       :: G.Guesser F.Tag
+    , disambModel   :: R.CRF S.Ob D.Part
+    , tagset        :: P.Tagset
+    , tierConf      :: [D.Tier] }
+
+instance Binary ConcraftData where
+    put ConcraftData{..} = do
+        put guesser
+        put disambModel
+        put tagset
+        put tierConf
+    get = ConcraftData <$> get <*> get <*> get <*> get
+
+data Concraft
+  = Train
+    { trainPath	    :: FilePath
+    , evalPath      :: Maybe FilePath
+    , format        :: Format
+    -- TODO: ignore tag should be related only to the Plain
+    -- format, but then 'Format' would not be an Enum instance.
+    -- Try another command line parsing library?
+    , tagsetPath    :: FilePath
+    , ignTag        :: String
+    , discardHidden :: Bool
+    , iterNum       :: Double
+    , batchSize     :: Int
+    , regVar        :: Double
+    , gain0         :: Double
+    , tau           :: Double
+    , outModel      :: FilePath
+    , guessNum      :: Int }
+  | Disamb
+    { format        :: Format
+    , ignTag        :: String
+    , inModel       :: FilePath
+    , guessNum      :: Int }
+  deriving (Data, Typeable, Show)
+
+trainMode :: Concraft
+trainMode = Train
+    { tagsetPath = def &= argPos 0 &= typ "TAGSET-PATH"
+    , trainPath = def &= argPos 1 &= typ "TRAIN-FILE"
+    , evalPath = def &= typFile &= help "Evaluation file"
+    , format = enum [Plain &= help "Plain format"]
+    , ignTag = def &= help "Tag indicating OOV word"
+    , discardHidden = False &= help "Discard hidden features"
+    , iterNum = 10 &= help "Number of SGD iterations"
+    , batchSize = 30 &= help "Batch size"
+    , regVar = 10.0 &= help "Regularization variance"
+    , gain0 = 1.0 &= help "Initial gain parameter"
+    , tau = 5.0 &= help "Initial tau parameter"
+    , outModel = def &= typFile &= help "Output Model file"
+    , guessNum = 10 &= help "Number of guessed tags for each unknown word" }
+
+disambMode :: Concraft
+disambMode = Disamb
+    { inModel = def &= argPos 0 &= typ "MODEL-FILE"
+    , format = enum [Plain &= help "Plain format"]
+    , ignTag = def &= help "Tag indicating OOV word"
+    , guessNum = 10 &= help "Number of guessed tags for each unknown word" }
+
+argModes :: Mode (CmdArgs Concraft)
+argModes = cmdArgsMode $ modes [trainMode, disambMode]
+
+main :: IO ()
+main = exec =<< cmdArgsRun argModes
+
+exec :: Concraft -> IO ()
+
+exec Train{..} = do
+    tagset' <- P.parseTagset tagsetPath <$> readFile tagsetPath
+    (guesser', disambModel') <- case format of
+        Plain   -> doTrain (plainFormat ign) tagset'
+    let concraftData = ConcraftData
+            { guesser       = guesser'
+            , disambModel   = disambModel'
+            , tagset        = tagset'
+            , tierConf      = D.tierConfDefault }
+    when (not . null $ outModel) $ do
+        putStrLn $ "\nSaving model in " ++ outModel ++ "..."
+        encodeFile outModel concraftData
+  where
+    doTrain docHandler tagset' = C.trainOn
+        docHandler guessConf sgdArgs
+        (disambTrain tagset')
+        trainPath evalPath
+    guessConf = C.GuessConf
+        { C.guessNum = guessNum
+        , C.guessSchema = S.guessSchemaDefault }
+    disambTrain tagset' = C.DisambWith
+        { C.disambConf = disambConf tagset'
+        , C.disambWith = R.train (length D.tierConfDefault) featSel sgdArgs }
+    disambConf tagset' = C.DisambConf
+        { C.split = D.split D.tierConfDefault . P.parseTag tagset'
+        , disambSchema = S.disambSchemaDefault }
+    featSel = if discardHidden
+        then R.selectPresent
+        else R.selectHidden
+    ign = T.pack ignTag
+    sgdArgs = SGD.SgdArgs
+        { SGD.batchSize = batchSize
+        , SGD.regVar = regVar
+        , SGD.iterNum = iterNum
+        , SGD.gain0 = gain0
+        , SGD.tau = tau }
+
+exec Disamb{..} = do
+    doTag <- doTagWith <$> decodeFile inModel <*> L.getContents
+    case format of
+        Plain   -> L.putStr $ doTag (plainFormat ign)
+  where
+    doTagWith ConcraftData{..} input docHandler =
+        let guessData = C.GuessData
+                { C.guessConf = C.GuessConf
+                    { C.guessNum = guessNum
+                    , guessSchema = S.guessSchemaDefault }
+                , C.guesser = guesser }
+            disambTag = C.DisambWith
+                { C.disambConf = C.DisambConf
+                    { C.split = D.split tierConf . P.parseTag tagset
+                    , C.disambSchema = S.disambSchemaDefault }
+                , C.disambWith = R.tag disambModel }
+        in  C.disambDoc docHandler guessData disambTag input
+    ign = T.pack ignTag