{- This file is part of language-kort.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Language.Kort.Writer
    ( writeString
    , writeText
    , writeFile
    , fromSmaoinValue
    , fromSmaoinModel
    )
where

import Prelude hiding (writeFile)
import qualified Data.ByteString.Base64.Lazy as B64
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BU
import Data.Char (ord)
import Data.Either (either)
import Data.List (intersperse, lines)
import Data.Monoid
import Data.Ratio (numerator, denominator)
import qualified Data.Smaoin as S
import qualified Data.Smaoin.Vocabulary.Smaoin as V.Smaoin
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.Encoding as TE
import Language.Kort.Types
import Numeric (showHex)
import Text.Razom.Char (isGraphical)
import Text.Razom.Uid (escapeUid)

wrapRes = (TB.singleton '<' <>) . (<> TB.singleton '>')

writeResource :: Resource -> TB.Builder
writeResource (Uid s)        = wrapRes $ TB.fromString $ escapeUid s
writeResource (LGenerator l) = wrapRes $ TB.singleton '%' <> TB.fromString l
writeResource UGenerator     = wrapRes $ TB.singleton '%'

writeElement :: Element -> TB.Builder
writeElement (Resource r) = writeResource r
writeElement (Value s r)  =
    TB.fromString "{{" <>
    TB.fromString s <>
    TB.fromString "}}::" <>
    writeResource r

writeStatement (Statement i r e) =
    mconcat $ intersperse (TB.singleton '\t') $
    writeResource i : writeResource r : map writeElement e

-- Split in newlines and replace other comment-invalid characters
writeComment :: String -> TB.Builder
writeComment s = mconcat $ (TB.fromString "-- " :) $
    map TB.fromString .
    intersperse "\n-- " .
    lines .
    map (\ c -> if isGraphical c || c == '\t' || c == '\n'
                then c else '\xfffd') $
    s

writeLine :: Line -> TB.Builder
writeLine = either writeComment writeStatement

-- | Write Kort model into a 'String'.
writeString :: Document -> String
writeString = T.unpack . writeText

-- | Write Kort model into 'T.Text'.
writeText :: Document -> T.Text
writeText = TB.toLazyText . mconcat . map ((<> TB.singleton '\n') . writeLine)

-- | Write Kort model into a file.
writeFile :: FilePath -> Document -> IO ()
writeFile fp = BL.writeFile fp . TE.encodeUtf8 . writeText

-- Get a Kort boolean literal.
writeBoolean :: Bool -> String
writeBoolean True  = "[x]"
writeBoolean False = "[_]"

-- Get a Kort real number literal.
writeRealNum :: S.RealNum -> String
writeRealNum n = show (S.sig n) ++ '$' : show (S.expo n)

-- Get a Kort rational number literal.
writeRatio :: S.Rational -> String
writeRatio r = show (numerator r) ++ '/' : show (denominator r)

-- Get a Kort character literal.
writeCharacter :: Char -> String
writeCharacter c
    | c `elem` "{}\\"     = ['\\', c]
    | not $ isGraphical c = '\\' : 'x' : showHex (ord c) ""
    | otherwise           = [c]

-- Get a Kort string literal.
writeStringL :: T.Text -> String
writeStringL = concatMap f . T.unpack
    where
    f c | c `elem` "{}\\"     = ['\\', c]
        | not $ isGraphical c = '\\' : 'x' : showHex (ord c) "\&"
        | otherwise           = [c]

-- Get a Kort data literal.
writeChunk :: BL.ByteString -> String
writeChunk = BLC.unpack . B64.encode

-- | Write a Smaoin value as a Kort literal.
fromSmaoinValue :: S.Value -> (String, S.Resource)
fromSmaoinValue (S.Boolean b)   = (writeBoolean b,   V.Smaoin._Boolean)
fromSmaoinValue (S.Number x)    =
    case x of
        S.RealNumber n         -> (writeRealNum n,   V.Smaoin._Number)
        S.RatioNumber n        -> (writeRatio n,     V.Smaoin._Number)
fromSmaoinValue (S.Character c) = (writeCharacter c, V.Smaoin._Character)
fromSmaoinValue (S.String s)    = (writeStringL s,   V.Smaoin._String)
fromSmaoinValue (S.Chunk d)     = (writeChunk d,     V.Smaoin._Data)
fromSmaoinValue (S.Generic t r) = (T.unpack t,       r)

fromSmaoinResource :: S.Resource -> Resource
fromSmaoinResource (S.Resource r) = Uid $ BU.toString r

fromSmaoinEntity :: S.Entity -> Element
fromSmaoinEntity (S.ResourceE r) = Resource $ fromSmaoinResource r
fromSmaoinEntity (S.ValueE v)    =
    let (s, r) = fromSmaoinValue v
    in  Value s (fromSmaoinResource r)

fromSmaoinStatement :: S.Statement -> Statement
fromSmaoinStatement (S.Statement i s p o) =
    Statement
        (fromSmaoinResource i)
        (fromSmaoinResource p)
        [ Resource $ fromSmaoinResource s
        , fromSmaoinEntity o
        ]

-- | Write a Smaoin model as a Kort document.
fromSmaoinModel :: [S.Statement] -> Document
fromSmaoinModel = map $ Right . fromSmaoinStatement