Annotation.hs

{-# LANGUAGE  OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Annotation (Annotations(..), parseDocstring) where

import qualified Data.ByteString.Lazy.Char8 as L8
import Control.Arrow (second, Arrow ((***)))
import Data.Bifunctor (bimap)
import Data.Aeson (ToJSON (toJSON))
import Data.Text.Encoding (decodeUtf8Lenient)
import Data.ByteString.Lazy.Char8 (toStrict)

type Accumulator = ([L8.ByteString], [(L8.ByteString, [L8.ByteString])])

newtype Annotations = Annotations { getAnnotations :: [(L8.ByteString, L8.ByteString)] }
  deriving (Semigroup, Monoid)

instance ToJSON Annotations where
    toJSON (Annotations as) = toJSON $ map (x *** x) $ filter (not.L8.null.snd) as
      where
        x = decodeUtf8Lenient . toStrict

parseDocstring :: L8.ByteString -> Annotations
parseDocstring x =
  let (comment, annotations) = parseDocstring' x
  in Annotations $ ("comment", comment):annotations


parseDocstring' :: L8.ByteString
                  -> (L8.ByteString, [(L8.ByteString, L8.ByteString)])
parseDocstring' = bimap (trimWhitespace . myUnlines . reverse)
                       (map (second $ myUnlines . reverse ) )
               . flip go mempty
               . L8.lines
  where
    go :: [L8.ByteString] -> Accumulator -> Accumulator
    -- we reverse the annotations to have it inserted in the db in the same
    -- order they are written in the file. that way we can use sqlites _rowid_
    -- to query the annotations in the same order as they were written.
    -- this *might* only work for fresh builds as i don't know if sqlite
    -- recycles their internal rowids.
    go [] acc = second reverse acc 
    go (x:xs) (descr, annotations)
        | Just ann <- getAnn x = go xs (descr, ann:annotations)
        | null annotations = go xs (x:descr, annotations)
        | otherwise =
            let (anTag, anLines):as = annotations
            in go xs (descr, (anTag, x:anLines):as)



    getAnn line =
        let words = map L8.unpack $ L8.words line
        in case words of
            ('@':ann):text -> Just (L8.pack ann, [trimWhitespace . L8.pack $ unwords text])
            _ -> Nothing



trimWhitespace :: L8.ByteString -> L8.ByteString
trimWhitespace =
    {-  L8.reverse
    . L8.dropWhile (\x -> x=='\r' || x == '\n') -- drop back newline
    . L8.reverse
    . -} L8.dropWhile (\x -> x=='\r' || x == '\n') -- drop front newline

myUnlines :: [L8.ByteString] -> L8.ByteString
myUnlines = L8.intercalate "\n"