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
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
writeString :: Document -> String
writeString = T.unpack . writeText
writeText :: Document -> T.Text
writeText = TB.toLazyText . mconcat . map ((<> TB.singleton '\n') . writeLine)
writeFile :: FilePath -> Document -> IO ()
writeFile fp = BL.writeFile fp . TE.encodeUtf8 . writeText
writeBoolean :: Bool -> String
writeBoolean True = "[x]"
writeBoolean False = "[_]"
writeRealNum :: S.RealNum -> String
writeRealNum n = show (S.sig n) ++ '$' : show (S.expo n)
writeRatio :: S.Rational -> String
writeRatio r = show (numerator r) ++ '/' : show (denominator r)
writeCharacter :: Char -> String
writeCharacter c
| c `elem` "{}\\" = ['\\', c]
| not $ isGraphical c = '\\' : 'x' : showHex (ord c) ""
| otherwise = [c]
writeStringL :: T.Text -> String
writeStringL = concatMap f . T.unpack
where
f c | c `elem` "{}\\" = ['\\', c]
| not $ isGraphical c = '\\' : 'x' : showHex (ord c) "\&"
| otherwise = [c]
writeChunk :: BL.ByteString -> String
writeChunk = BLC.unpack . B64.encode
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
]
fromSmaoinModel :: [S.Statement] -> Document
fromSmaoinModel = map $ Right . fromSmaoinStatement